Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -168,11 +168,11 @@ ((allruns-by-id (make-hash-table)) : hash-table) ;; hash of run-id -> dboard:rundat records ((done-runs '()) : list) ;; list of runs already drawn ((not-done-runs '()) : list) ;; list of runs not yet drawn (header #f) ;; header for decoding the run records (keys #f) ;; keys for this run (i.e. target components) - ((numruns (string->number (or (args:get-arg "-cols") "8"))) : number) ;; + ((numruns (string->number (or (args:get-arg "-cols") "10"))) : number) ;; ((tot-runs 0) : number) ((last-data-update 0) : number) ;; last time the data in allruns was updated ((last-runs-update 0) : number) ;; last time we pulled the runs info to update the tree (runs-mutex (make-mutex)) ;; use to prevent parallel access to draw objects ((run-update-times (make-hash-table)) : hash-table) ;; update times indexed by run-id @@ -483,11 +483,13 @@ ;; gets all the tests for run-id that match testnamepatt and key-vals, merges them ;; ;; NOTE: Yes, this is used ;; (define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals) - (let* ((num-to-get 20) + (let* ((num-to-get (let ((n (configf:lookup *configdat* "dashboard" "num-to-get"))) + (if n (string->number n) + 30))) (states (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat))) (statuses (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat))) (sort-info (get-curr-sort)) (sort-by (vector-ref sort-info 1)) (sort-order (vector-ref sort-info 2)) @@ -525,11 +527,11 @@ (let ((ht (make-hash-table))) (dboard:rundat-tests-set! run-dat ht) ht) (dboard:rundat-tests run-dat))) (start-time (current-seconds))) - + ;; (dashboard:set-db-update-time tabdat) ;; indicate that we did read the db at this time ;; to limit the amount of data transferred each cycle use limit of num-to-get and offset (dboard:rundat-run-data-offset-set! run-dat (if (< (length tmptests) num-to-get) 0 @@ -937,11 +939,11 @@ (hash-table-set! (dboard:tabdat-searchpatts tabdat) x val) (dboard:tabdat-filters-changed-set! tabdat #t) (set-bg-on-filter commondat tabdat)) (define (mark-for-update tabdat) - (dboard:tabdat-filters-changed-set! tabdat #t) + ;; (dboard:tabdat-filters-changed-set! tabdat #t) (dboard:tabdat-last-db-update-set! tabdat 0)) ;;====================================================================== ;; R U N C O N T R O L ;;====================================================================== @@ -1446,35 +1448,38 @@ ;; (set! colnum (+ colnum 1)) )))) run-ids))) (define (dashboard:run-id->tests-mindat run-id tabdat runs-hash) - (let* ((run (hash-table-ref/default runs-hash run-id #f)) + (let* ((run (hash-table-ref/default runs-hash run-id #f)) ;; extra (last-update (hash-table-ref/default (dboard:tabdat-run-update-times tabdat) run-id 0)) (db-path (or (hash-table-ref/default (dboard:tabdat-run-db-paths tabdat) run-id #f) (let* ((db-dir (tasks:get-task-db-path)) (db-pth (conc db-dir "/" run-id ".db"))) (hash-table-set! (dboard:tabdat-run-db-paths tabdat) run-id db-pth) db-pth))) - (key-vals (rmt:get-key-vals run-id)) - (testnamepatt (or (dboard:tabdat-test-patts tabdat) "%")) + (key-vals (rmt:get-key-vals run-id)) ;; extra + (testnamepatt (or (dboard:tabdat-test-patts tabdat) "%")) ;; extra (tests-dat (if (or (not run-id) (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps") (not (hash-table-exists? (dboard:tabdat-last-test-dat tabdat) run-id)) (>= (file-modification-time db-path) last-update)) (let ((res - (dboard:get-tests-dat tabdat run-id last-update) + (dboard:get-tests-dat tabdat run-id 0) ;; "0)" was: "last-update)" ;; NOTE FROM 1.61 --> ;; DO NOT USE last-update yet. Need to redesign this to use dboard:get-tests-for-run-duplicate ;; TODO: replace above line (get-tests-dat) with below line (get-tests-for-run-duplicate); above is a list, below is a hash - therein lies the problem. The minimize-test-data depends on a pre-sorted list as input; hash is by nature unsorted. and its not a list. ;;(dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals) )) - (hash-table-set! (dboard:tabdat-last-test-dat tabdat) run-id res) - (hash-table-set! (dboard:tabdat-run-update-times tabdat) run-id (- (current-seconds) 10)) + res) (hash-table-ref (dboard:tabdat-last-test-dat tabdat) run-id))) (tests-mindat (dcommon:minimize-test-data tests-dat))) ;; reduces data for display + (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2)) ;; moved to here to group with other update timestamp recordings + (hash-table-set! (dboard:tabdat-last-test-dat tabdat) run-id tests-dat) ;; moved out of one branch of test-dat let cond + (hash-table-set! (dboard:tabdat-run-update-times tabdat) run-id (- (current-seconds) 10)) ;; ditto + tests-mindat)) (define (dashboard:runs-summary-xor-matrix-content tabdat runs-hash) (let* ((src-run-id (dboard:tabdat-prev-run-id tabdat)) (dest-run-id (dboard:tabdat-curr-run-id tabdat))) @@ -1481,11 +1486,11 @@ (if (and src-run-id dest-run-id) (dcommon:xor-tests-mindat (dashboard:run-id->tests-mindat src-run-id tabdat runs-hash) (dashboard:run-id->tests-mindat dest-run-id tabdat runs-hash)) #f))) - +- (define (dashboard:runs-summary-updater commondat tabdat tb cell-lookup run-matrix) (dboard:runs-summary-control-panel-updater tabdat) (let* ((last-runs-update (dboard:tabdat-last-runs-update tabdat)) (runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records @@ -1495,11 +1500,11 @@ (for-each (lambda (run) (hash-table-set! ht (db:get-value-by-header run runs-header "id") run)) runs) ht))) (dboard:update-tree tabdat runs-hash runs-header tb) - (if run-id + (if run-id ;; moved matrix-content calculation code to run-id->tests-mindat (let* ((matrix-content (case (dboard:tabdat-runs-summary-mode tabdat) ((one-run) (dashboard:run-id->tests-mindat run-id tabdat runs-hash)) ((xor-two-runs) (dashboard:runs-summary-xor-matrix-content tabdat runs-hash)) (else (dashboard:run-id->tests-mindat run-id tabdat runs-hash))))) @@ -1514,14 +1519,12 @@ (numcols 1) (changed #f) ) - (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2)) - - (dboard:tabdat-filters-changed-set! tabdat #f) + (dboard:tabdat-filters-changed-set! tabdat #f) ;; refactor coalesces here (let loop ((pass-num 0) (changed #f)) ;; Update the runs tree (dboard:update-tree tabdat runs-hash runs-header tb) @@ -1991,27 +1994,27 @@ (dboard:tabdat-start-run-offset-set! tabdat val) (mark-for-update tabdat) (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax) (iup:attribute-set! obj "MAX" (* maxruns 10)))) #:expand "HORIZONTAL" - #:max (* 10 (length (dboard:tabdat-allruns tabdat))) + #:max (* 10 (max (hash-table-size (dboard:tabdat-allruns-by-id tabdat)) 10)) #:min 0 #:step 0.01))) ;;(iup:button "inc rows" #:action (lambda (obj)(dboard:tabdat-num-tests-set! tabdat (+ (dboard:tabdat-num-tests tabdat) 1)))) ;(iup:button "dec rows" #:action (lambda (obj)(dboard:tabdat-num-tests-set! tabdat (if (> (dboard:tabdat-num-tests tabdat) 0)(- (dboard:tabdat-num-tests tabdat) 1) 0)))) ))) -(define (dashboard:popup-menu buttndat run-id test-id target runname test-name testpatt) +(define (dashboard:popup-menu buttndat run-id test-id target runname test-name testpatt item-test-path) (iup:menu (iup:menu-item "Run" (iup:menu (iup:menu-item (conc "Rerun " testpatt) #:action (lambda (obj) - ;;(print "buttndat: " buttndat " run-id: " run-id " test-id: " test-id " target: " target " runname: " runname " test-name: " test-name " testpatt: " testpatt) + ;; (print "buttndat: " buttndat " run-id: " run-id " test-id: " test-id " target: " target " runname: " runname " test-name: " test-name " testpatt: " testpatt "item-path : " item-path) (common:run-a-command (conc "megatest -run -target " target " -runname " runname " -testpatt " testpatt " -preclean -clean-cache") @@ -2035,36 +2038,36 @@ " -testpatt % ")))))) (iup:menu-item "Test" (iup:menu (iup:menu-item - (conc "Rerun " test-name) + (conc "Rerun " item-test-path) #:action (lambda (obj) (common:run-a-command (conc "megatest -set-state-status NOT_STARTED,n/a -run -target " target " -runname " runname - " -testpatt " test-name + " -testpatt " item-test-path " -preclean -clean-cache")))) (iup:menu-item - (conc "Kill " test-name) + (conc "Kill " item-test-path) #:action (lambda (obj) ;; (rmt:test-set-state-status-by-id run-id test-id "KILLREQ" #f #f) (common:run-a-command (conc "megatest -set-state-status KILLREQ,n/a -target " target " -runname " runname - " -testpatt " test-name + " -testpatt " item-test-path " -state RUNNING,REMOTEHOSTSTART,LAUNCHED")))) (iup:menu-item - (conc "Clean " test-name) + (conc "Clean "item-test-path) #:action (lambda (obj) (common:run-a-command (conc "megatest -remove-runs -target " target " -runname " runname - " -testpatt " test-name)))) + " -testpatt " item-test-path)))) (iup:menu-item "Start xterm" #:action (lambda (obj) (dcommon:examine-xterm run-id test-id))) @@ -2214,12 +2217,16 @@ (if tlast (let ((tpatt (tasks:task-get-testpatt tlast))) (if (member tpatt '("0" 0)) ;; known bad historical value - remove in 2017 "%" tpatt)) - "%")))) - (iup:show (dashboard:popup-menu buttndat run-id test-id target runname test-name testpatt) ;; popup-menu + "%"))) + (item-path (db:test-get-item-path (rmt:get-test-info-by-id run-id test-id))) + (item-test-path (conc test-name "/" (if (equal? item-path "") + "%" + item-path)))) + (iup:show (dashboard:popup-menu buttndat run-id test-id target runname test-name testpatt item-test-path) ;; popup-menu #:x 'mouse #:y 'mouse #:modal? "NO") ;; (print "got here") )) @@ -2568,11 +2575,11 @@ (dboard:tabdat-max-row-set! tabdat 0) (dboard:tabdat-last-filter-str-set! tabdat filtrstr))) (update-rundat tabdat runpatt ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") - 10 ;; (dboard:tabdat-numruns tabdat) + (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" "%") targpatt Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -507,10 +507,11 @@ (apply 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)) + (dashboard:set-db-update-time tabdat) (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)) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -1041,11 +1041,11 @@ ;; (args:get-arg "-testpatt") ;; "%")) (keys (rmt:get-keys)) ;; (db:get-keys dbstruct)) ;; (runsda t (db:get-runs dbstruct runpatt #f #f '())) (runsdat (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) ;; (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target) - #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment"))) + #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0)) (runstmp (db:get-rows runsdat)) (header (db:get-header runsdat)) ;; this is "-since" support. This looks at last mod times of .db files ;; and collects those modified since the -since time. (runs (if (and (not (null? runstmp))