Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -1754,10 +1754,12 @@ (debug:print 0 *default-log-port* "INFO: test " test-id " on host " host " has a process on pid " pid ", NOT setting to DEAD.") (begin (debug:print 0 *default-log-port* "INFO: test " test-id " final state/status is not COMPLETED/PASS. It is " result) (db:set-state-status-and-roll-up-items dbstruct run-id test-id 'foo "COMPLETED" "DEAD" "Test stopped responding while in RUNNING or REMOTEHOSTSTART; presumed dead."))))))) + ;; call end of eud of run detection for posthook - from merge, is it needed? + ;; (launch:end-of-run-check run-id) all-ids) ;;call end of eud of run detection for posthook (launch:end-of-run-check run-id) ))))))) Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -616,70 +616,74 @@ ;; 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:stats-updater commondat tabdat stats-matrix) + (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)) + (max-col-vis (if (> max-col 10) 10 max-col)) + (numrows 1) + (numcols 1)) + (debug:print 0 *default-log-port* "GOT HERE, stats-matrix: " stats-matrix) + (iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS") + (iup:attribute-set! stats-matrix "NUMCOL" max-col ) + (iup:attribute-set! stats-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20 + (iup:attribute-set! stats-matrix "NUMCOL_VISIBLE" max-col-vis) + (iup:attribute-set! stats-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row)) + (print "row-indices: " row-indices " col-indices: " col-indices) + ;; Row labels + (for-each (lambda (ind) + (let* ((name (car ind)) + (num (cadr ind)) + (key (conc num ":0"))) + (if (not (equal? (iup:attribute stats-matrix key) name)) + (begin + (set! changed #t) + (iup:attribute-set! stats-matrix key name))))) + row-indices) + + ;; Col labels + (for-each (lambda (ind) + (let* ((name (car ind)) + (num (cadr ind)) + (key (conc "0:" num))) + (if (not (equal? (iup:attribute stats-matrix key) name)) + (begin + (set! changed #t) + (iup:attribute-set! stats-matrix key name))))) + col-indices) + + ;; Cell contents + (for-each (lambda (entry) + (let* ((row-name (car entry)) + (col-name (cadr entry)) + (value (caddr entry)) + (row-num (cadr (assoc row-name row-indices))) + (col-num (cadr (assoc col-name col-indices))) + (key (conc row-num ":" col-num))) + (if (not (equal? (iup:attribute stats-matrix key) value)) + (begin + (set! changed #t) + (iup:attribute-set! stats-matrix key value))))) + run-stats) + (if changed (iup:attribute-set! stats-matrix "REDRAW" "ALL"))))) + (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)) - (max-col-vis (if (> max-col 10) 10 max-col)) - (numrows 1) - (numcols 1)) - (iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS") - (iup:attribute-set! stats-matrix "NUMCOL" max-col ) - (iup:attribute-set! stats-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20 - (iup:attribute-set! stats-matrix "NUMCOL_VISIBLE" max-col-vis) - (iup:attribute-set! stats-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row)) - - ;; Row labels - (for-each (lambda (ind) - (let* ((name (car ind)) - (num (cadr ind)) - (key (conc num ":0"))) - (if (not (equal? (iup:attribute stats-matrix key) name)) - (begin - (set! changed #t) - (iup:attribute-set! stats-matrix key name))))) - row-indices) - - ;; Col labels - (for-each (lambda (ind) - (let* ((name (car ind)) - (num (cadr ind)) - (key (conc "0:" num))) - (if (not (equal? (iup:attribute stats-matrix key) name)) - (begin - (set! changed #t) - (iup:attribute-set! stats-matrix key name))))) - col-indices) - - ;; Cell contents - (for-each (lambda (entry) - (let* ((row-name (car entry)) - (col-name (cadr entry)) - (value (caddr entry)) - (row-num (cadr (assoc row-name row-indices))) - (col-num (cadr (assoc col-name col-indices))) - (key (conc row-num ":" col-num))) - (if (not (equal? (iup:attribute stats-matrix key) value)) - (begin - (set! changed #t) - (iup:attribute-set! stats-matrix key value))))) - run-stats) - (if changed (iup:attribute-set! stats-matrix "REDRAW" "ALL"))) - )))) + (dcommon:stats-updater commondat tabdat stats-matrix)))) ;; (dboard:commondat-please-update-set! commondat #t) ;; force redraw on first pass ;; (mark-for-update tabdat) ;; (stats-updater) (dboard:commondat-add-updater commondat stats-updater tab-num: tab-num) ;; (set! dashboard:update-summary-tab updater)