Megatest

Check-in [a0e40d2621]
Login
Overview
Comment:merged v1.63
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.63-readonly
Files: files | file ages | folders
SHA1: a0e40d2621843068f6b60b491f23e788a3c10d0a
User & Date: bjbarcla on 2017-02-22 12:35:42
Other Links: branch diff | manifest | tags
Context
2017-02-22
13:53
merged in read-only support check-in: 46372e7493 user: bjbarcla tags: v1.63
12:35
merged v1.63 Closed-Leaf check-in: a0e40d2621 user: bjbarcla tags: v1.63-readonly
11:45
cleaned up debug message check-in: 5d0de7eba5 user: bjbarcla tags: v1.63-readonly
2017-02-17
20:48
Pulled in fix for dashboard launching check-in: 56bd54e48e user: matt tags: v1.63
Changes

Modified dashboard-tests.scm from [a5c62d93cd] to [84e8bdf580].

43
44
45
46
47
48
49
50

51
52
53
54
55
56
57
43
44
45
46
47
48
49

50
51
52
53
54
55
56
57







-
+








(define (dtests:get-pre-command #!key (default-override #f))
  (let ((cfg-ovrd (configf:lookup *configdat* "dashboard" "pre-command")))
    (or cfg-ovrd default-override "viewscreen "))) ;; "xterm -geometry 180x20 -e \"")))

(define (dtests:get-post-command #!key (default-override #f))
  (let ((cfg-ovrd (configf:lookup *configdat* "dashboard" "post-command")))
    (or cfg-ovrd default-override ""))) ;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
    (or cfg-ovrd default-override " &"))) ;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))


(define (test-info-panel testdat store-label widgets)
  (iup:frame 
   #:title "Test Info" ; #:expand "YES"
   (iup:hbox ; #:expand "YES"
    (apply iup:vbox ; #:expand "YES"

Modified db.scm from [e5728a46fb] to [b1610e98a8].

2671
2672
2673
2674
2675
2676
2677
2678


2679
2680
2681
2682
2683
2684
2685
2671
2672
2673
2674
2675
2676
2677

2678
2679
2680
2681
2682
2683
2684
2685
2686







-
+
+







  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (sqlite3:first-result
      db
      "SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ');"))))
      "SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ') AND run_id=?;")
     run-id)))

;; map run-id, testname item-path to test-id
(define (db:get-test-id dbstruct run-id testname item-path)
  (db:with-db
   dbstruct
   run-id
   #f
2752
2753
2754
2755
2756
2757
2758
2759

2760
2761
2762
2763
2764
2765
2766
2767
2768

2769
2770
2771
2772
2773
2774
2775
2753
2754
2755
2756
2757
2758
2759

2760
2761
2762
2763
2764
2765
2766
2767
2768

2769
2770
2771
2772
2773
2774
2775
2776







-
+








-
+







	run-id)))
    res))

(define (db:replace-test-records dbstruct run-id testrecs)
  (db:with-db dbstruct run-id #t 
	      (lambda (db)
		(let* ((qmarks (string-intersperse (make-list (length db:test-record-fields) "?") ","))
		       (qrystr (conc "INSERT OR REPLACE INTO tests (" db:test-record-qry-selector ") VALUES (" qmarks ");"))
		       (qrystr (conc "INSERT OR REPLACE INTO tests (" db:test-record-qry-selector ") VALUES (" qmarks ") WHERE run_id=?;"))
		       (qry    (sqlite3:prepare db qrystr)))
		  (debug:print 0 *default-log-port* "INFO: migrating test records for run with id " run-id)
		  (sqlite3:with-transaction
		   db
		   (lambda ()
		     (for-each 
		      (lambda (rec)
			;; (debug:print 0 *default-log-port* "INFO: Inserting values: " (string-intersperse (map conc (vector->list rec)) ",") "\n")
			(apply sqlite3:execute qry (vector->list rec)))
			(apply sqlite3:execute qry (append (vector->list rec)(list run-id))))
		      testrecs)))
		  (sqlite3:finalize! qry)))))

;; map a test-id into the proper range
;;
(define (db:adj-test-id mtdb min-test-id test-id)
  (if (>= test-id min-test-id)
3660
3661
3662
3663
3664
3665
3666
3667
3668



3669
3670
3671
3672
3673
3674
3675
3661
3662
3663
3664
3665
3666
3667


3668
3669
3670
3671
3672
3673
3674
3675
3676
3677







-
-
+
+
+







     run-id
     #f
     (lambda (db)
       (sqlite3:for-each-row 
	(lambda (id itempath state status run_duration logf comment)
	  (set! res (cons (vector id itempath state status run_duration logf comment) res)))
	db
	"SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE testname=? AND item_path != '';"
	test-name)
	"SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE testname=? AND item_path != '' AND run_id=?;" ;; BUG! WHY NO run_id?
	test-name
	run-id)
       res))))

;;======================================================================
;; Tests meta data
;;======================================================================

;; returns a hash table of tags to tests

Modified megatest-version.scm from [ecea7b3d2a] to [813a77d970].

1
2
3
4
5
6

7
1
2
3
4
5

6
7





-
+

;; Always use two or four digit decimal
;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.6307)
(define megatest-version 1.6308)