Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -3968,10 +3968,78 @@ ;; (db:set-state-status-and-roll-up-items dbstruct run-id test-id #f state status msg) ;; ;; process the test_data table ;; (if (and test-id state status (equal? status "AUTO")) ;; (db:test-data-rollup dbstruct run-id test-id status)) ;; (mt:process-triggers dbstruct run-id test-id state status))) + +;; NOT FINISHED +(define (db:calc-state-status-toplevel state status tl-state tl-status) + `(,state ,status)) + +;; (match state +;; (("COMPLETED") +;; (match `(,tl-state ,tl-status) +;; (("COMPLETED" "PASS") `(,state ,status)) +;; (("COMPLETED" thestatus) +;; (case (string->symbol thestatus) +;; ((ABORT CHECK DEAD) +;; (if `("COMPLETED" ,thestatus)) +;; (match `(,thestatus ,status) +;; (("FAIL" "ABORT") '("COMPLETED" "ABORT")) +;; (("FAIL" "CHECK") '("COMPLETED" "CHECK")) +;; (("FAIL" "DEAD") '("COMPLETED" "DEAD")) +;; (("WARN" "FAIL") '("COMPLETED" "FAIL")) +;; (("WARN" "CHECK") '("COMPLETED" "CHECK")) +;; (("WARN" "DEAD") + + +(define (db:set-state-status-and-roll-up-items-fast dbstruct run-id test-name item-path state status comment) + ;; establish info on incoming test followed by info on top level test + ;; BBnote - for mode itemwait, linkage between upstream test & matching item status is propagated to run queue in db:prereqs-not-met + (mutex-lock! *db-transaction-mutex*) + (db:with-db + dbstruct #f #f + (lambda (db) + (let ((tr-res + (sqlite3:with-transaction + db + (lambda () + (let* ((testdat (if (number? test-name) + (db:get-test-info-by-id dbstruct run-id test-name) ;; test-name is actually a test-id + (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 (if tl-testdat + (db:test-get-id tl-testdat) + #f))) + (if (member state '("LAUNCHED" "REMOTEHOSTSTART")) + (db:general-call dbstruct 'set-test-start-time (list test-id))) + (if (member state '("LAUNCHED" "REMOTEHOSTSTART" "RUNNING")) + (begin ;; set test to launched and top level to RUNNING and we are done + (if tl-test-id + (db:test-set-state-status db run-id tl-test-id "RUNNING" #f #f)) ;; we are still in the transaction - must access the db and not the dbstruct + (db:test-set-state-status db run-id test-id state status #f)) + (begin ;; + (db:test-set-state-status db run-id test-id state status comment) ;; this call sets the item state/status + (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item + (let* ((tl-state (db:test-get-state tl-testdat)) + (tl-status (db:test-get-status tl-testdat)) + (newss (db:calc-state-status-toplevel state status tl-state tl-status))) + (match newss + ((new-tl-state new-tl-status) + (db:test-set-state-status db run-id tl-test-id new-tl-state new-tl-status)) + (else + #f))))))))))) + (mutex-unlock! *db-transaction-mutex*) + (if (and test-id state status (equal? status "AUTO")) + (db:test-data-rollup dbstruct run-id test-id status)) + tr-res)))) + ;; state is the priority rollup of all states ;; status is the priority rollup of all completed statesfu ;; ;; if test-name is an integer work off that instead of test-name test-path @@ -4003,11 +4071,11 @@ (lambda () ;; NB// Pass the db so it is part fo the transaction (db:test-set-state-status db run-id test-id state status comment) ;; this call sets the item state/status (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item (let* ((state-status-counts (db:get-all-state-status-counts-for-test dbstruct run-id test-name item-path state status)) ;; item-path is used to exclude current state/status of THIS test - (state-stauses (db:roll-up-rules state-status-counts state status)) + (state-stauses (db:roll-up-rules state-status-counts state status)) (newstate (car state-stauses)) (newstatus (cadr state-stauses))) (debug:print 4 *default-log-port* "BB> tl-test-id="tl-test-id" ; "test-name":"item-path" newstate="newstate" newstatus="newstatus" len(sscs)="(length state-status-counts) " state-status-counts: " (apply conc (map (lambda (x)