| ︙ | | | ︙ | |
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
;; 1. Make "data" hash-table hierarchial store of all displayed data
;; 2. Update synchash to understand "get-runs", "get-tests" etc.
;; 3. Add extraction of filters to synchash calls
;;
;; NOTE: Used in newdashboard
;;
;; Mode is 'full or 'incremental for full refresh or incremental refresh
(define (dcommon:run-update keys data runname keypatts testpatt states statuses mode window-id)
(let* (;; count and offset => #f so not used
;; the synchash calls modify the "data" hash
(changed #f)
(get-runs-sig (conc (client:get-signature) " get-runs"))
(get-tests-sig (conc (client:get-signature) " get-tests"))
(get-details-sig (conc (client:get-signature) " get-test-details"))
;; test-ids to get and display are indexed on window-id in curr-test-ids hash
(test-ids (hash-table-values (dboard:tabdat-curr-test-ids data)))
;; run-id is #f in next line to send the query to server 0
(run-changes (synchash:client-get 'db:get-runs get-runs-sig (length keypatts) data #f runname #f #f keypatts))
(tests-detail-changes (if (not (null? test-ids))
(synchash:client-get 'db:get-test-info-by-ids get-details-sig 0 data #f test-ids)
'()))
;; Now can calculate the run-ids
(run-hash (hash-table-ref/default data get-runs-sig #f))
(run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '()))
(all-test-changes (let ((res (make-hash-table)))
(for-each (lambda (run-id)
(if (> run-id 0)
(hash-table-set! res run-id (synchash:client-get 'db:get-tests-for-run-mindata get-tests-sig 0 data run-id 1 testpatt states statuses #f))))
run-ids)
res))
(runs-hash (hash-table-ref/default data get-runs-sig #f))
(header (hash-table-ref/default runs-hash "header" #f))
(run-ids (sort (filter number? (hash-table-keys runs-hash))
(lambda (a b)
(let* ((record-a (hash-table-ref runs-hash a))
|
|
|
|
|
|
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
;; 1. Make "data" hash-table hierarchial store of all displayed data
;; 2. Update synchash to understand "get-runs", "get-tests" etc.
;; 3. Add extraction of filters to synchash calls
;;
;; NOTE: Used in newdashboard
;;
;; Mode is 'full or 'incremental for full refresh or incremental refresh
(define (dcommon:run-update area-dat keys data runname keypatts testpatt states statuses mode window-id)
(let* (;; count and offset => #f so not used
;; the synchash calls modify the "data" hash
(changed #f)
(get-runs-sig (conc (client:get-signature) " get-runs"))
(get-tests-sig (conc (client:get-signature) " get-tests"))
(get-details-sig (conc (client:get-signature) " get-test-details"))
;; test-ids to get and display are indexed on window-id in curr-test-ids hash
(test-ids (hash-table-values (dboard:tabdat-curr-test-ids data)))
;; run-id is #f in next line to send the query to server 0
(run-changes (synchash:client-get area-dat 'db:get-runs get-runs-sig (length keypatts) data #f runname #f #f keypatts))
(tests-detail-changes (if (not (null? test-ids))
(synchash:client-get area-dat 'db:get-test-info-by-ids get-details-sig 0 data #f test-ids)
'()))
;; Now can calculate the run-ids
(run-hash (hash-table-ref/default data get-runs-sig #f))
(run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '()))
(all-test-changes (let ((res (make-hash-table)))
(for-each (lambda (run-id)
(if (> run-id 0)
(hash-table-set! res run-id (synchash:client-get area-dat 'db:get-tests-for-run-mindata get-tests-sig 0 data run-id 1 testpatt states statuses #f))))
run-ids)
res))
(runs-hash (hash-table-ref/default data get-runs-sig #f))
(header (hash-table-ref/default runs-hash "header" #f))
(run-ids (sort (filter number? (hash-table-keys runs-hash))
(lambda (a b)
(let* ((record-a (hash-table-ref runs-hash a))
|
| ︙ | | | ︙ | |
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
|
(not
(equal?
"CLEAN"
(list-ref (list-ref item 2) 1))))
res)
res))))
(define (dcommon:examine-xterm run-id test-id)
(let* ((testdat (rmt:get-test-info-by-id run-id test-id)))
(if (not testdat)
(begin
(debug:print 2 "ERROR: No test data found for test " test-id ", exiting")
(exit 1))
(let*
((rundir (if testdat
(db:test-get-rundir testdat)
|
|
|
|
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
|
(not
(equal?
"CLEAN"
(list-ref (list-ref item 2) 1))))
res)
res))))
(define (dcommon:examine-xterm area-dat run-id test-id)
(let* ((testdat (rmt:get-test-info-by-id area-dat run-id test-id)))
(if (not testdat)
(begin
(debug:print 2 "ERROR: No test data found for test " test-id ", exiting")
(exit 1))
(let*
((rundir (if testdat
(db:test-get-rundir testdat)
|
| ︙ | | | ︙ | |
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
|
;; (iup:attribute-set! general-matrix "2:1" *toppath*)
;; Megatest version
(iup:attribute-set! general-matrix "2:0" "Version")
(iup:attribute-set! general-matrix "2:1" (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))
general-matrix))
(define (dcommon:run-stats commondat tabdat #!key (tab-num #f))
(let* ((stats-matrix (iup:matrix expand: "YES"))
(changed #f)
(stats-updater (lambda ()
(if (dashboard:database-changed? commondat tabdat context-key: 'run-stats)
(let* ((run-stats (rmt:get-run-stats))
(indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell))
(row-indices (car indices))
(col-indices (cadr indices))
(max-row (if (null? row-indices) 1 (common:max (map cadr row-indices))))
(max-col (if (null? col-indices) 1
(common:max (map cadr col-indices))))
(max-visible (max (- (dboard:tabdat-num-tests tabdat) 15) 3))
|
|
|
|
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
|
;; (iup:attribute-set! general-matrix "2:1" *toppath*)
;; Megatest version
(iup:attribute-set! general-matrix "2:0" "Version")
(iup:attribute-set! general-matrix "2:1" (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))
general-matrix))
(define (dcommon:run-stats area-dat commondat tabdat #!key (tab-num #f))
(let* ((stats-matrix (iup:matrix expand: "YES"))
(changed #f)
(stats-updater (lambda ()
(if (dashboard:database-changed? commondat tabdat context-key: 'run-stats)
(let* ((run-stats (rmt:get-run-stats area-dat))
(indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell))
(row-indices (car indices))
(col-indices (cadr indices))
(max-row (if (null? row-indices) 1 (common:max (map cadr row-indices))))
(max-col (if (null? col-indices) 1
(common:max (map cadr col-indices))))
(max-visible (max (- (dboard:tabdat-num-tests tabdat) 15) 3))
|
| ︙ | | | ︙ | |
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
|
(iup:attribute-set! tb "VALUE" val)
(dboard:tabdat-run-name-set! tabdat val)
(dashboard:update-run-command tabdat))))
"command-runname-selector lb action"))))
(refresh-runs-list (lambda ()
(if (dashboard:database-changed? commondat tabdat context-key: 'runname-selector-runs-list)
(let* (;; (target (dboard:tabdat-target-string tabdat))
(runs-for-targ (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f 0))
(runs-header (vector-ref runs-for-targ 0))
(runs-dat (vector-ref runs-for-targ 1))
(run-names (cons default-run-name
(map (lambda (x)
(db:get-value-by-header x runs-header "runname"))
runs-dat))))
;; (print "DEBUGINFO: run-names=" run-names)
|
|
|
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
|
(iup:attribute-set! tb "VALUE" val)
(dboard:tabdat-run-name-set! tabdat val)
(dashboard:update-run-command tabdat))))
"command-runname-selector lb action"))))
(refresh-runs-list (lambda ()
(if (dashboard:database-changed? commondat tabdat context-key: 'runname-selector-runs-list)
(let* (;; (target (dboard:tabdat-target-string tabdat))
(runs-for-targ (rmt:get-runs-by-patt area-dat (dboard:tabdat-keys tabdat) "%" #f #f #f #f 0))
(runs-header (vector-ref runs-for-targ 0))
(runs-dat (vector-ref runs-for-targ 1))
(run-names (cons default-run-name
(map (lambda (x)
(db:get-value-by-header x runs-header "runname"))
runs-dat))))
;; (print "DEBUGINFO: run-names=" run-names)
|
| ︙ | | | ︙ | |