︙ | | | ︙ | |
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
;; 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"))
;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn")
(thread-start! (make-thread common:watchdog "Watchdog thread"))
;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn")
;; (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
|
>
>
|
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
;; TODO: Move this inside (main)
;;
(if (not (launch:setup))
(begin
(print "Failed to find megatest.config, exiting")
(exit 1)))
;; RA => Might require revert for filters
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn")
(thread-start! (make-thread common:watchdog "Watchdog thread"))
;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn")
;; (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
|
︙ | | | ︙ | |
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
|
states ;; states for -state s1,s2 ...
statuses ;; statuses for -status s1,s2 ...
;; Selector variables
curr-run-id ;; current row to display in Run summary view
prev-run-id ;; previous runid selected before current runid was selected (used in xor-two-runs runs summary mode
curr-test-ids ;; used only in dcommon:run-update which is used in newdashboard
((filters-changed #t) : boolean) ;; to to indicate that the user changed filters for this tab
((last-filter-str "") : string) ;; conc the target runname and testpatt for a signature of changed filters
((hide-empty-runs #f) : boolean)
((hide-not-hide #t) : boolean) ;; toggle for hide/not hide empty runs
(hide-not-hide-button #f)
((searchpatts (make-hash-table)) : hash-table) ;;
((state-ignore-hash (make-hash-table)) : hash-table) ;; hash of STATE => #t/#f for display control
((status-ignore-hash (make-hash-table)) : hash-table) ;; hash of STATUS => #t/#f
|
|
|
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
|
states ;; states for -state s1,s2 ...
statuses ;; statuses for -status s1,s2 ...
;; Selector variables
curr-run-id ;; current row to display in Run summary view
prev-run-id ;; previous runid selected before current runid was selected (used in xor-two-runs runs summary mode
curr-test-ids ;; used only in dcommon:run-update which is used in newdashboard
((filters-changed #t) : boolean) ;; to indicate that the user changed filters for this tab
((last-filter-str "") : string) ;; conc the target runname and testpatt for a signature of changed filters
((hide-empty-runs #f) : boolean)
((hide-not-hide #t) : boolean) ;; toggle for hide/not hide empty runs
(hide-not-hide-button #f)
((searchpatts (make-hash-table)) : hash-table) ;;
((state-ignore-hash (make-hash-table)) : hash-table) ;; hash of STATE => #t/#f for display control
((status-ignore-hash (make-hash-table)) : hash-table) ;; hash of STATUS => #t/#f
|
︙ | | | ︙ | |
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
|
(define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)
(let* ((start-time (current-seconds))
(access-mode (dboard:tabdat-access-mode tabdat))
(num-to-get (string->number (or (configf:lookup *configdat* "setup" "num-tests-to-get")
"200")))
(states (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)))
(statuses (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)))
(do-not-use-db-file-timestamps #f) ;; (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")) ;; this still hosts runs-summary-tab
(do-not-use-query-timestamps #f) ;; (configf:lookup *configdat* "setup" "do-not-use-query-timestamps")) ;; this no longer troubles runs-summary-tab
(sort-info (get-curr-sort))
(sort-by (vector-ref sort-info 1))
(sort-order (vector-ref sort-info 2))
(bubble-type (if (member sort-order '(testname))
'testname
'itempath))
;; note: the rundat is normally created in "update-rundat".
|
|
|
|
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
|
(define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)
(let* ((start-time (current-seconds))
(access-mode (dboard:tabdat-access-mode tabdat))
(num-to-get (string->number (or (configf:lookup *configdat* "setup" "num-tests-to-get")
"200")))
(states (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)))
(statuses (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)))
(do-not-use-db-file-timestamps #t) ;; (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")) ;; this still hosts runs-summary-tab
(do-not-use-query-timestamps #t) ;; (configf:lookup *configdat* "setup" "do-not-use-query-timestamps")) ;; this no longer troubles runs-summary-tab
(sort-info (get-curr-sort))
(sort-by (vector-ref sort-info 1))
(sort-order (vector-ref sort-info 2))
(bubble-type (if (member sort-order '(testname))
'testname
'itempath))
;; note: the rundat is normally created in "update-rundat".
|
︙ | | | ︙ | |
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
|
(hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
(hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)) ;; '()
(hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)) ;; '()
#f #f ;; offset limit
(dboard:tabdat-hide-not-hide tabdat) ;; not-in
#f #f ;; sort-by sort-order
#f ;; get all? "id,testname,item_path,state,status,event_time,run_duration" ;; qryval
(if (dboard:tabdat-filters-changed tabdat)
0
last-update)
*dashboard-mode*)
'()))) ;; get 'em all
;; (debug:print 0 *default-log-port* "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id)
(sort tdat (lambda (a b)
(let* ((aval (vector-ref a 2))
(bval (vector-ref b 2))
(anum (string->number aval))
|
|
|
|
|
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
|
(hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
(hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)) ;; '()
(hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)) ;; '()
#f #f ;; offset limit
(dboard:tabdat-hide-not-hide tabdat) ;; not-in
#f #f ;; sort-by sort-order
#f ;; get all? "id,testname,item_path,state,status,event_time,run_duration" ;; qryval
(if (dboard:tabdat-filters-changed tabdat)
0
last-update)
*dashboard-mode*)
'()))) ;; get 'em all
;; (debug:print 0 *default-log-port* "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id)
(sort tdat (lambda (a b)
(let* ((aval (vector-ref a 2))
(bval (vector-ref b 2))
(anum (string->number aval))
|
︙ | | | ︙ | |
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
|
(col-num (cadr (assoc col-name col-indices)))
(key (conc row-num ":" col-num)))
(hash-table-set! cell-lookup key test-id)
(if (not (equal? (iup:attribute run-matrix key) (cadr value)))
(begin
(set! changed #t)
(iup:attribute-set! run-matrix key (cadr value))
;; (print "RA=> value" (car value))
(iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value))))))
matrix-content)
;; Col labels - do after setting Cell contents so they are accounted for in the size calc.
(for-each (lambda (ind)
(let* ((name (car ind))
|
<
|
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
|
(col-num (cadr (assoc col-name col-indices)))
(key (conc row-num ":" col-num)))
(hash-table-set! cell-lookup key test-id)
(if (not (equal? (iup:attribute run-matrix key) (cadr value)))
(begin
(set! changed #t)
(iup:attribute-set! run-matrix key (cadr value))
(iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value))))))
matrix-content)
;; Col labels - do after setting Cell contents so they are accounted for in the size calc.
(for-each (lambda (ind)
(let* ((name (car ind))
|
︙ | | | ︙ | |