Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -354,14 +354,14 @@ '((0 "ARCHIVED") (1 "STUCK") (2 "KILLREQ") (3 "KILLED") (4 "NOT_STARTED") - (5 "RUNNING") + (5 "COMPLETED") (6 "LAUNCHED") (7 "REMOTEHOSTSTART") - (8 "COMPLETED") + (8 "RUNNING") )) (define *common:std-statuses* '(;; (0 "DELETED") (1 "n/a") @@ -371,10 +371,13 @@ (5 "WARN") (6 "WAIVED") (7 "STUCK/DEAD") (8 "FAIL") (9 "ABORT"))) + +(define *common:ended-states* ;; states which indicate the test is stopped and will not proceed + '("COMPLETED" "ARCHIVED" "KILLED" "KILLREQ" "STUCK" "INCOMPLETE")) (define (common:special-sort items order comp) (let ((items-order (map reverse order)) (acomp (or comp >))) (sort items Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -3177,40 +3177,44 @@ ;; status is the priority rollup of all completed states ;; ;; if test-name is an integer work off that instead of test-name test-path ;; (define (db:set-state-status-and-roll-up-items dbstruct run-id test-name item-path state status #!key (comment #f)) + ;; establish info on incoming test followed by info on top level test (let* ((db (db:dbdat-get-db (dbr:dbstruct-tmpdb dbstruct))) - (testdat1 (if (number? test-name) + (testdat (if (number? test-name) (db:get-test-info-by-id dbstruct run-id test-name) - #f)) - (orig-test-id (if testdat1 (db:test-get-id testdat1) #f)) ;; the item - (test-name (if testdat1 (db:test-get-testname testdat1) test-name)) - (testdat (db:get-test-info dbstruct run-id test-name "")) - (test-id (db:test-get-id testdat)) - (item-path (db:test-get-item-path (or testdat1 testdat)))) + (db:get-test-info dbstruct run-id test-name item-path))) + (test-id (db:test-get-id testdat)) + (test-name (if (number? test-name) + (db:test-get-testname testdat) + test-name)) + (item-path (db:test-get-item-path testdat)) + (tl-testdat (db:get-test-info dbstruct run-id test-name "")) + (tl-test-id (db:test-get-id tl-testdat))) (print "Got here.") (sqlite3:with-transaction db (lambda () - (if orig-test-id (db:test-set-state-status-by-id dbstruct run-id orig-test-id state status comment)) - (if (not (equal? item-path "")) ;; only roll up IF we are an item + (db:test-set-state-status-by-id dbstruct run-id test-id state status comment) + (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item (let* ((all-curr-states (common:special-sort (delete-duplicates - (let ((states (db:get-all-item-states db run-id test-name))) + (let ((states (db:get-all-item-states db run-id test-name))) (if state (cons state states) states))) *common:std-states* >)) (all-curr-statuses (common:special-sort (delete-duplicates (let ((statuses (db:get-all-item-statuses db run-id test-name))) - (if (equal? state "COMPLETED") + (if (member state *common:ended-states*) ;; '("COMPLETED" "ARCHIVED")) (cons status statuses) statuses))) *common:std-statuses* >)) (newstate (if (null? all-curr-states) "NOT_STARTED" (car all-curr-states))) (newstatus (if (null? all-curr-statuses) "n/a" (car all-curr-statuses)))) - (db:test-set-state-status-by-id dbstruct run-id test-id newstate newstatus #f))))))) + (print "Setting toplevel to: " newstate "/" newstatus) + (db:test-set-state-status-by-id dbstruct run-id tl-test-id newstate newstatus #f))))))) (define db:roll-up-pass-fail-counts db:set-state-status-and-roll-up-items) ;; call with state = #f to roll up with out accounting for state/status of this item ;;