| ︙ | | |
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
+
+
+
+
+
+
+
+
+
|
;; TODO: Move this inside (main)
;;
(if (not (launch:setup))
(begin
(print "Failed to find megatest.config, exiting")
(exit 1)))
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
(if (file-write-access? (conc *toppath* "/megatest.db"))
(thread-start! (make-thread common:watchdog "Watchdog thread"))
(if (not (args:get-arg "-use-db-cache"))
(begin
(debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
(hash-table-set! args:arg-hash "-use-db-cache" #t))))
;; data common to all tabs goes here
;;
(defstruct dboard:commondat
((curr-tab-num 0) : number)
please-update
tabdats
update-mutex
|
| ︙ | | |
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
|
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
|
-
+
|
(dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db"))
;; HACK ALERT: this is a hack, please fix.
(dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat))))
(dboard:tabdat-keys-set! tabdat (db:dispatch-query (db:get-access-mode) rmt:get-keys db:get-keys))
(dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname")))
(dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%"))
(dboard:tabdat-tot-runs-set! tabdat (db:dispatch-query (db:get-access-mode) rmt:get-num-runs db:get-num-runs "%"))
)
;; RADT => Matrix defstruct addition
(defstruct dboard:graph-dat
((id #f) : string)
((color #f) : vector)
((flag #t) : boolean)
|
| ︙ | | |
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
|
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
|
-
+
|
(let loop ((run (car runs))
(tal (cdr runs))
(res '())
(maxtests 0))
(let* ((run-id (db:get-value-by-header run header "id"))
(run-struct (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f))
(last-update (if run-struct (dboard:rundat-last-update run-struct) 0))
(key-vals (rmt:get-key-vals run-id))
(key-vals (db:dispatch-query (db:get-access-mode) rmt:get-key-vals db:get-key-vals run-id))
(tests-ht (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))
;; GET RID OF dboard:get-tests-dat - it is superceded by dboard:get-tests-for-run-duplicate
;; dboard:get-tests-for-run-duplicate - returns a hash table
;; (dboard:get-tests-dat tabdat run-id last-update))
(all-test-ids (hash-table-keys tests-ht))
(num-tests (length all-test-ids)))
;; (print "run-struct: " run-struct)
|
| ︙ | | |
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
|
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
|
-
+
|
(let ((newval (car values)))
(iup:attribute-set! lb "VALUE" newval)
newval))))))
(define (dashboard:update-target-selector tabdat #!key (action-proc #f))
(let* ((runconf-targs (common:get-runconfig-targets))
(key-lbs (dboard:tabdat-key-listboxes tabdat))
(db-target-dat (rmt:get-targets))
(db-target-dat (db:dispatch-query (db:get-access-mode) rmt:get-targets db: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.
(list->vector
(take (append (string-split x "/")
(make-list (length header) "na"))
(length header)))))
|
| ︙ | | |