Megatest

Diff
Login

Differences From Artifact [dae6ad3930]:

To Artifact [d87d9bd145]:


84
85
86
87
88
89
90





91
92
93
94
95
96
97
			"-v"
			"-q"
			"-use-local"
			"-skip-version-check"
			)
		 args:arg-hash
		 0))






(if (args:get-arg "-h")
    (begin
      (print help)
      (exit)))

;; TODO: Move this inside (main)







>
>
>
>
>







84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
			"-v"
			"-q"
			"-use-local"
			"-skip-version-check"
			)
		 args:arg-hash
		 0))

(if (not (null? remargs))
    (begin
      (print "Unrecognised arguments: " (string-intersperse remargs " "))
      (exit)))

(if (args:get-arg "-h")
    (begin
      (print help)
      (exit)))

;; TODO: Move this inside (main)
254
255
256
257
258
259
260

261
262
263
264
265
266
267
268
269
270
271

  ;; tests data
  ((num-tests          10)               : number)      ;; total number of tests to show (used in the old runs display)

  ;; runs tree
  ((path-run-ids       (make-hash-table)) : hash-table) ;; path (target / runname) => id
  (runs-tree           #f)


  ;; tab data
  ((view-changed       #t)                : boolean)
  ((rebuild-dwg        #t)                : boolean)
  ((xadj               0)                 : number)     ;; x slider number (if using canvas)
  ((yadj               0)                 : number)     ;; y slider number (if using canvas)
  ;; runs-summary tab state
  ((runs-summary-modes '((one-run . "Show One Run") (xor-two-runs . "XOR Two Runs") (xor-two-runs-hide-clean . "XOR; Hide Clean")) )   : list)
  ((runs-summary-mode-buttons '())               : list)
  ((runs-summary-mode  'one-run)            : symbol)
  ((runs-summary-mode-change-callbacks '()) : list)







>



|







259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277

  ;; tests data
  ((num-tests          10)               : number)      ;; total number of tests to show (used in the old runs display)

  ;; runs tree
  ((path-run-ids       (make-hash-table)) : hash-table) ;; path (target / runname) => id
  (runs-tree           #f)
  ((runs-tree-ht       (make-hash-table)) : hash-table) ;; track which targests added to tree (merge functionality with path-run-ids?)

  ;; tab data
  ((view-changed       #t)                : boolean)
  ((rebuild-dwg        #f)                : boolean)
  ((xadj               0)                 : number)     ;; x slider number (if using canvas)
  ((yadj               0)                 : number)     ;; y slider number (if using canvas)
  ;; runs-summary tab state
  ((runs-summary-modes '((one-run . "Show One Run") (xor-two-runs . "XOR Two Runs") (xor-two-runs-hide-clean . "XOR; Hide Clean")) )   : list)
  ((runs-summary-mode-buttons '())               : list)
  ((runs-summary-mode  'one-run)            : symbol)
  ((runs-summary-mode-change-callbacks '()) : list)
1172
1173
1174
1175
1176
1177
1178

1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193




1194

1195
1196
1197
1198
1199
1200
1201

;; used by run-controls
;;
(define (dashboard:update-tree-selector tabdat #!key (action-proc #f))
  (let* ((tb            (dboard:tabdat-runs-tree tabdat))
	 (runconf-targs (common:get-runconfig-targets))
	 (db-target-dat (rmt:get-targets))

	 (header        (vector-ref db-target-dat 0))
	 (db-targets    (vector-ref db-target-dat 1))
	 (munge-target  (lambda (x)            ;; create a target vector from a string. Pad with na if needed.
			  (take (append (string-split x "/")
					(make-list (length header) "na"))
				(length header))))
	 (all-targets   (append (list (munge-target (string-intersperse 
						     (map (lambda (x) "%") header)
						     "/")))
				(map vector->list db-targets)
				(map munge-target
				     runconf-targs)
				)))
    (for-each
     (lambda (target)




       (tree:add-node tb "Runs" target)) ;; (append key-vals (list run-name))

     all-targets)))

;; Run controls panel
;;
(define (dashboard:run-controls commondat tabdat #!key (tab-num #f))
  (let* ((targets       (make-hash-table))
	 (test-records  (make-hash-table))







>















>
>
>
>
|
>







1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213

;; used by run-controls
;;
(define (dashboard:update-tree-selector tabdat #!key (action-proc #f))
  (let* ((tb            (dboard:tabdat-runs-tree tabdat))
	 (runconf-targs (common:get-runconfig-targets))
	 (db-target-dat (rmt:get-targets))
         (runs-tree-ht  (dboard:tabdat-runs-tree-ht tabdat))
	 (header        (vector-ref db-target-dat 0))
	 (db-targets    (vector-ref db-target-dat 1))
	 (munge-target  (lambda (x)            ;; create a target vector from a string. Pad with na if needed.
			  (take (append (string-split x "/")
					(make-list (length header) "na"))
				(length header))))
	 (all-targets   (append (list (munge-target (string-intersperse 
						     (map (lambda (x) "%") header)
						     "/")))
				(map vector->list db-targets)
				(map munge-target
				     runconf-targs)
				)))
    (for-each
     (lambda (target)
       (if (not (hash-table-ref/default runs-tree-ht target #f))
           ;; (let ((existing (tree:find-node tb target)))
           ;;   (if (not existing)
           (begin
             (tree:add-node tb "Runs" target) ;; (append key-vals (list run-name))
             (hash-table-set! runs-tree-ht target #t))))
     all-targets)))

;; Run controls panel
;;
(define (dashboard:run-controls commondat tabdat #!key (tab-num #f))
  (let* ((targets       (make-hash-table))
	 (test-records  (make-hash-table))
1512
1513
1514
1515
1516
1517
1518
1519

1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
    (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
    (for-each (lambda (run-id)
		(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
		       (key-vals   (map (lambda (key)(db:get-value-by-header run-record runs-header key))
					(dboard:tabdat-keys tabdat)))
		       (run-name   (db:get-value-by-header run-record runs-header "runname"))
		       (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
		       (run-path   (append key-vals (list run-name)))

		       (existing   (tree:find-node tb run-path)))
		  (if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
		      (begin
			(hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
			;; (iup:attribute-set! (dboard:tabdat-runs-matrix tabdat)
			;;    		 (conc rownum ":" colnum) col-name)
			;; (hash-table-set! runid-to-col run-id (list colnum run-record))
			;; Here we update the tests treebox and tree keys
			(tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
				       userdata: (conc "run-id: " run-id))
			(hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
			;; (set! colnum (+ colnum 1))
			))))
	      run-ids)))

(define (dashboard:tests-ht->tests-dat tests-ht)
  (reverse
   (sort
    (hash-table-values tests-ht)
    (lambda (a b) 







|
>
|
|
|
|
|
|
|
|
|
|
|
|
|







1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
    (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
    (for-each (lambda (run-id)
		(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
		       (key-vals   (map (lambda (key)(db:get-value-by-header run-record runs-header key))
					(dboard:tabdat-keys tabdat)))
		       (run-name   (db:get-value-by-header run-record runs-header "runname"))
		       (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
		       (run-path   (append key-vals (list run-name))))
		  (if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
                      ;; (let ((existing   (tree:find-node tb run-path)))
                      ;;   (if (not existing)
                      (begin
                        (hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
                        ;; (iup:attribute-set! (dboard:tabdat-runs-matrix tabdat)
                        ;;    		 (conc rownum ":" colnum) col-name)
                        ;; (hash-table-set! runid-to-col run-id (list colnum run-record))
                        ;; Here we update the tests treebox and tree keys
                        (tree:add-node tb "Runs" run-path) ;; (append key-vals (list run-name))
                        ;;                                             userdata: (conc "run-id: " run-id))))
                        (hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
                        ;; (set! colnum (+ colnum 1))
                        ))))
	      run-ids)))

(define (dashboard:tests-ht->tests-dat tests-ht)
  (reverse
   (sort
    (hash-table-values tests-ht)
    (lambda (a b) 
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
	(for-each
	 (lambda (run-id)
	   (let* ((run-record (hash-table-ref/default runs-hash run-id #f))
		  (key-vals   (map (lambda (key)(db:get-value-by-header run-record runs-header key))
				   (dboard:tabdat-keys tabdat)))
		  (run-name   (db:get-value-by-header run-record runs-header "runname"))
		  (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
		  (run-path   (append key-vals (list run-name)))
		  (existing   (tree:find-node tb run-path)))
	     (if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
		 (begin
		   (hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
		   ;; Here we update the tests treebox and tree keys
		   (tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
				  userdata: (conc "run-id: " run-id))
		   (hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
		   ;; (set! colnum (+ colnum 1))
		   ))))
	 run-ids))
    ;; (print "Updating rundat")
    (if (dboard:tabdat-keys tabdat) ;; have keys yet?
	(let* ((num-keys (length (dboard:tabdat-keys tabdat)))







|
|




|
|







2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
	(for-each
	 (lambda (run-id)
	   (let* ((run-record (hash-table-ref/default runs-hash run-id #f))
		  (key-vals   (map (lambda (key)(db:get-value-by-header run-record runs-header key))
				   (dboard:tabdat-keys tabdat)))
		  (run-name   (db:get-value-by-header run-record runs-header "runname"))
		  (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
		  (run-path   (append key-vals (list run-name))))
             ;; 		  (existing   (tree:find-node tb run-path)))
	     (if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
		 (begin
		   (hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
		   ;; Here we update the tests treebox and tree keys
		   (tree:add-node tb "Runs" run-path) ;; (append key-vals (list run-name))
                   ;;				  userdata: (conc "run-id: " run-id))
		   (hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
		   ;; (set! colnum (+ colnum 1))
		   ))))
	 run-ids))
    ;; (print "Updating rundat")
    (if (dboard:tabdat-keys tabdat) ;; have keys yet?
	(let* ((num-keys (length (dboard:tabdat-keys tabdat)))
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
                                   (list? (dboard:tabdat-target tabdat))
                                   (not (null? (dboard:tabdat-target tabdat))))
                              (last (dboard:tabdat-target tabdat))
                              "%"))
	       (testpatt  (or (dboard:tabdat-test-patts tabdat) "%"))
	       (filtrstr  (conc targpatt "/" runpatt "/" testpatt)))
	  ;; (print "targpatt: " targpatt " runpatt: " runpatt " testpatt: " testpatt)
          (print "RA => dboard:tabdat-last-filter-str " dboard:tabdat-last-filter-str "filtrstr" filtrstr "dboard:tabdat-view-changed" (dboard:tabdat-view-changed tabdat))

	  (if (or (not (equal? (dboard:tabdat-last-filter-str tabdat) filtrstr))
                  (dboard:tabdat-rebuild-dwg tabdat))
	      (let ((dwg (dboard:tabdat-drawing tabdat)))
		(print "resetting drawing")
		(dboard:tabdat-layout-update-ok-set! tabdat #f)
		(vg:drawing-libs-set! dwg (make-hash-table))
		(vg:drawing-insts-set! dwg (make-hash-table))
		(vg:drawing-cache-set! dwg '())
		(dboard:tabdat-allruns-by-id-set! tabdat (make-hash-table))
		;; (dboard:tabdat-allruns-set! tabdat '())
		(dboard:tabdat-max-row-set! tabdat 0)
		(dboard:tabdat-last-filter-str-set! tabdat filtrstr)
                ;; (dboard:tabdat-rebuild-dwg-set! tabdat #f)
                ))
	  (update-rundat tabdat
			 runpatt
			 ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") 
			 (dboard:tabdat-numruns tabdat)
			 testpatt ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
			 ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")







<













|







2774
2775
2776
2777
2778
2779
2780

2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
                                   (list? (dboard:tabdat-target tabdat))
                                   (not (null? (dboard:tabdat-target tabdat))))
                              (last (dboard:tabdat-target tabdat))
                              "%"))
	       (testpatt  (or (dboard:tabdat-test-patts tabdat) "%"))
	       (filtrstr  (conc targpatt "/" runpatt "/" testpatt)))
	  ;; (print "targpatt: " targpatt " runpatt: " runpatt " testpatt: " testpatt)


	  (if (or (not (equal? (dboard:tabdat-last-filter-str tabdat) filtrstr))
                  (dboard:tabdat-rebuild-dwg tabdat))
	      (let ((dwg (dboard:tabdat-drawing tabdat)))
		(print "resetting drawing")
		(dboard:tabdat-layout-update-ok-set! tabdat #f)
		(vg:drawing-libs-set! dwg (make-hash-table))
		(vg:drawing-insts-set! dwg (make-hash-table))
		(vg:drawing-cache-set! dwg '())
		(dboard:tabdat-allruns-by-id-set! tabdat (make-hash-table))
		;; (dboard:tabdat-allruns-set! tabdat '())
		(dboard:tabdat-max-row-set! tabdat 0)
		(dboard:tabdat-last-filter-str-set! tabdat filtrstr)
                (dboard:tabdat-rebuild-dwg-set! tabdat #f)
                ))
	  (update-rundat tabdat
			 runpatt
			 ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") 
			 (dboard:tabdat-numruns tabdat)
			 testpatt ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
			 ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
	  (vg:drawing-xoff-set! dwg (dboard:tabdat-xadj tabdat))
	  (vg:drawing-yoff-set! dwg (dboard:tabdat-yadj tabdat))
	  (mutex-lock! mtx)
	  (canvas-clear! cnv)
	  (vg:draw dwg tabdat)
          ;; RA => (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num)
	  (mutex-unlock! mtx)
          (print "RA => View changed found to be set" )
	  (dboard:tabdat-view-changed-set! tabdat #f)))))
  
;; doesn't work.
;;
;;(define (gotoescape tabdat escape)
;;  (or (dboard:tabdat-layout-update-ok tabdat)
;;      (escape #t)))







<







2826
2827
2828
2829
2830
2831
2832

2833
2834
2835
2836
2837
2838
2839
	  (vg:drawing-xoff-set! dwg (dboard:tabdat-xadj tabdat))
	  (vg:drawing-yoff-set! dwg (dboard:tabdat-yadj tabdat))
	  (mutex-lock! mtx)
	  (canvas-clear! cnv)
	  (vg:draw dwg tabdat)
          ;; RA => (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num)
	  (mutex-unlock! mtx)

	  (dboard:tabdat-view-changed-set! tabdat #f)))))
  
;; doesn't work.
;;
;;(define (gotoescape tabdat escape)
;;  (or (dboard:tabdat-layout-update-ok tabdat)
;;      (escape #t)))