@@ -122,37 +122,42 @@ updaters: (make-hash-table) updating: #f hide-not-hide-tabs: #f )) +;; RA => returns the tabdat stored at hashkey passed in commondat-tabdats table (e.g. 0 gives summary) +;; (define (dboard:common-get-tabdat commondat #!key (tab-num #f)) (hash-table-ref/default (dboard:commondat-tabdats commondat) - (or tab-num (dboard:commondat-curr-tab-num commondat)) + (or tab-num (dboard:commondat-curr-tab-num commondat)) ;; tab-num value is curr-tab-num value in passed commondat #f)) +;; RA => sets the tabdat passed to the hashkey at commondat:tabdats hash table +;; (define (dboard:common-set-tabdat! commondat tabnum tabdat) (hash-table-set! (dboard:commondat-tabdats commondat) tabnum tabdat)) -;; gets and calls updater based on curr-tab-num +;; gets and calls updater list based on curr-tab-num (define (dboard:common-run-curr-updaters commondat #!key (tab-num #f)) (if (dboard:common-get-tabdat commondat tab-num: tab-num) ;; only update if there is a tabdat (let* ((tnum (or tab-num (dboard:commondat-curr-tab-num commondat))) (updaters (hash-table-ref/default (dboard:commondat-updaters commondat) tnum '()))) (debug:print 4 *default-log-port* "Found these updaters: " updaters " for tab-num: " tnum) - (for-each + (for-each ;; perform the function calls for the complete updaters list (lambda (updater) ;; (debug:print 3 *default-log-port* "Running " updater) (updater)) updaters)))) ;; if tab-num passed in then use it, otherwise look in commondat at curr-tab-num +;; adds the updater passed in the updaters list at that hashkey ;; (define (dboard:commondat-add-updater commondat updater #!key (tab-num #f)) (let* ((tnum (or tab-num (dboard:commondat-curr-tab-num commondat))) (curr-updaters (hash-table-ref/default (dboard:commondat-updaters commondat) tnum '()))) @@ -168,11 +173,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 +488,11 @@ ;; 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 100) (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)) @@ -801,11 +806,10 @@ (lftcol (dboard:uidat-get-lftcol uidat)) (tableheader (dboard:uidat-get-header uidat)) (table (dboard:uidat-get-runsvec uidat)) (coln 0) (all-test-names (make-hash-table))) - ;; create a concise list of test names ;; (for-each (lambda (rundat) (if rundat @@ -903,10 +907,11 @@ (curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE"))) (if (not (equal? curr-color color)) (iup:attribute-set! button "BGCOLOR" color)) (if (not (equal? curr-title buttontxt)) (iup:attribute-set! button "TITLE" buttontxt)) + ;;(print "RA => testdat " testdat " teststate " teststate " teststatus " teststatus " buttondat " buttondat " curr-color " curr-color " curr-title " curr-title "buttontxt" buttontxt " title " curr-title ) (vector-set! buttondat 0 run-id) (vector-set! buttondat 1 color) (vector-set! buttondat 2 buttontxt) (vector-set! buttondat 3 testdat) (vector-set! buttondat 4 run-key))) @@ -937,11 +942,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 ;;====================================================================== @@ -2025,11 +2030,11 @@ (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)))) ))) @@ -2041,11 +2046,11 @@ (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) (common:run-a-command (conc "megatest -run -target " target " -runname " runname " -testpatt " testpatt " -preclean -clean-cache") @@ -2064,11 +2069,20 @@ #:action (lambda (obj) (common:run-a-command (conc "megatest -remove-runs -target " target " -runname " runname - " -testpatt % ")))))) + " -testpatt % ")))) + (iup:menu-item ;; RADT => itemize this run lists before merging with v1.61 + "Kill Complete Run" + #:action + (lambda (obj) + (common:run-a-command + (conc "megatest -set-state-status KILLREQ,n/a -target " target + " -runname " runname + " -testpatt % " + " -state RUNNING,REMOTEHOSTSTART,LAUNCHED")))))) (iup:menu-item "Test" (iup:menu (iup:menu-item (conc "Rerun " test-name) @@ -2123,11 +2137,11 @@ )))) (define (make-dashboard-buttons commondat) ;; runs-sum-dat new-view-dat) (let* ((stats-dat (dboard:tabdat-make-data)) (runs-dat (dboard:tabdat-make-data)) - (onerun-dat (dboard:tabdat-make-data)) + (onerun-dat (dboard:tabdat-make-data)) ;; name for run-summary structure (runcontrols-dat (dboard:tabdat-make-data)) (runtimes-dat (dboard:tabdat-make-data)) (nruns (dboard:tabdat-numruns runs-dat)) (ntests (dboard:tabdat-num-tests runs-dat)) (keynames (dboard:tabdat-dbkeys runs-dat)) @@ -2431,10 +2445,12 @@ ;; point inside line ;; (define-inline (dashboard:px-between px lx1 lx2) (and (< lx1 px)(> lx2 px))) +;;Not reference anywhere +;; ;; can a bar be placed in row "rownum" covering x1 to x2 without overlapping with existing ;; bars? Use num-rows to check that a block will fit from rownum to (+ rownum num-rows) ;; (define (dashboard:row-collision rowhash rownum x1 x2 #!key (num-rows #f)) (let ((lastrow (if num-rows (+ rownum num-rows) rownum))) @@ -2602,11 +2618,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 @@ -3023,15 +3039,85 @@ (escapeloop #t) ;; (dboard:tabdat-layout-update-ok tabdat) ))))))))) ;; new-run-start-row ))) (debug:print 2 *default-log-port* "no tabdat for run-times-tab-updater")))) +(define (tabdat-values tabdat) + (let ((allruns (dboard:tabdat-allruns tabdat)) + (allruns-by-id (dboard:tabdat-allruns-by-id tabdat)) + (done-runs (dboard:tabdat-done-runs tabdat)) + (not-done-runs (dboard:tabdat-not-done-runs tabdat)) + (header (dboard:tabdat-header tabdat)) + (keys (dboard:tabdat-keys tabdat)) + (numruns (dboard:tabdat-numruns tabdat)) + (tot-runs (dboard:tabdat-tot-runs tabdat)) + (last-data-update (dboard:tabdat-last-data-update tabdat)) + (runs-mutex (dboard:tabdat-runs-mutex tabdat)) + (run-update-times (dboard:tabdat-run-update-times tabdat)) + (last-test-dat (dboard:tabdat-last-test-dat tabdat)) + (run-db-paths (dboard:tabdat-run-db-paths tabdat)) + (buttondat (dboard:tabdat-buttondat tabdat)) + (item-test-names (dboard:tabdat-item-test-names tabdat)) + (run-keys (dboard:tabdat-run-keys tabdat)) + (start-run-offset (dboard:tabdat-start-run-offset tabdat)) + (start-test-offset (dboard:tabdat-start-test-offset tabdat)) + (runs-btn-height (dboard:tabdat-runs-btn-height tabdat)) + (all-test-names (dboard:tabdat-all-test-names tabdat)) + (cnv (dboard:tabdat-cnv tabdat)) + (command (dboard:tabdat-command tabdat)) + (run-name (dboard:tabdat-run-name tabdat)) + (states (dboard:tabdat-states tabdat)) + (statuses (dboard:tabdat-statuses tabdat)) + (curr-run-id (dboard:tabdat-curr-run-id tabdat)) + (curr-test-ids (dboard:tabdat-curr-test-ids tabdat)) + (state-ignore-hash (dboard:tabdat-state-ignore-hash tabdat)) + (test-patts (dboard:tabdat-test-patts tabdat)) + (target (dboard:tabdat-target tabdat)) + (dbdir (dboard:tabdat-dbdir tabdat)) + (monitor-db-path (dboard:tabdat-monitor-db-path tabdat)) + (path-run-ids (dboard:tabdat-path-run-ids tabdat))) + (print "allruns is : " allruns) + (print "allruns-by-id is : " allruns-by-id) + (print "done-runs is : " done-runs) + (print "not-done-runs is : " not-done-runs) + (print "header is : " header ) + (print "keys is : " keys) + (print "numruns is : " numruns) + (print "tot-runs is : " tot-runs) + (print "last-data-update is : " last-data-update) + (print "runs-mutex is : " runs-mutex) + (print "run-update-times is : " run-update-times) + (print "last-test-dat is : " last-test-dat) + (print "run-db-paths is : " run-db-paths) + (print "buttondat is : " buttondat) + (print "item-test-names is : " item-test-names) + (print "run-keys is : " run-keys) + (print "start-run-offset is : " start-run-offset) + (print "start-test-offset is : " start-test-offset) + (print "runs-btn-height is : " runs-btn-height) + (print "all-test-names is : " all-test-names) + (print "cnv is : " cnv) + (print "command is : " command) + (print "run-name is : " run-name) + (print "states is : " states) + (print "statuses is : " statuses) + (print "curr-run-id is : " curr-run-id) + (print "curr-test-ids is : " curr-test-ids) + (print "state-ignore-hash is : " state-ignore-hash) + (print "test-patts is : " test-patts) + (print "target is : " target) + (print "dbdir is : " dbdir) + (print "monitor-db-path is : " monitor-db-path) + (print "path-run-ids is : " path-run-ids))) + (define (dashboard:runs-tab-updater commondat tab-num) (debug:catch-and-dump (lambda () (let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)) (dbkeys (dboard:tabdat-dbkeys tabdat))) + ;;(print "RA => calling runs-tab-updater with commondat " commondat " tab-num " tab-num) + ;;(tabdat-values tabdat) ;;RA added (update-rundat tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat) (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%") ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%") @@ -3049,10 +3135,11 @@ dbkeys) res)))) ;; (debug:print 0 *default-log-port* "fres: " fres) fres))) (let ((uidat (dboard:commondat-uidat commondat))) + ;;(print "RA => Calling update-buttons with tabdat : " tabdat " uidat " uidat) (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat))) )) "dashboard:runs-tab-updater")) ;; ((2) @@ -3076,20 +3163,20 @@ (if (not (args:get-arg "-skip-version-check"))(common:exit-on-version-changed)) (let* ((commondat (dboard:commondat-make))) ;; Move this stuff to db.scm? I'm not sure that is the right thing to do... (cond ((args:get-arg "-test") ;; run-id,test-id - (let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ",")))) + (let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ",")))) ;; RADT couldn't find string->number, though it works (if (> (length d) 1) d (list #f #f)))) (run-id (car dat)) (test-id (cadr dat))) (if (and (number? run-id) (number? test-id) (>= test-id 0)) - (examine-test run-id test-id) + (dashboard-tests:examine-test run-id test-id) (begin (debug:print 3 *default-log-port* "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test")) (exit 1))))) ;; ((args:get-arg "-guimonitor") ;; (gui-monitor (dboard:tabdat-dblocal tabdat)))