Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -3522,18 +3522,19 @@ (car all-curr-statuses))))) ;; (print "bad-not-supported: " bad-not-support " all-curr-states: " all-curr-states " all-curr-statuses: " all-curr-states) ;; " newstate: " newstate " newstatus: " newstatus) ;; NB// Pass the db so it is part of the transaction - (debug:print 4 *default-log-port* "BB> tl-test-id="tl-test-id" ; "test-name":"item-path"> bad-not-started="bad-not-started" newstate="newstate" newstatus="newstatus" num-non-completes="num-non-completes" non-completes="non-completes "len(sscs)="(length state-status-counts) " state-status-counts: " - (apply conc - (map (lambda (x) - (conc - (with-output-to-string (lambda () (pp (dbr:counts->alist x)))) " | ")) - state-status-counts)) - - ); end debug:print + + ;; (debug:print 4 *default-log-port* "BB> tl-test-id="tl-test-id" ; "test-name":"item-path"> bad-not-started="bad-not-started" newstate="newstate" newstatus="newstatus" num-non-completes="num-non-completes" non-completes="non-completes "len(sscs)="(length state-status-counts) " state-status-counts: " + ;; (apply conc + ;; (map (lambda (x) + ;; (conc + ;; (with-output-to-string (lambda () (pp (dbr:counts->alist x)))) " | ")) + ;; state-status-counts)) + + ;; ); end debug:print (if tl-test-id (db:test-set-state-status db run-id tl-test-id newstate newstatus #f)) ;; we are still in the transaction - must access the db and not the dbstruct )))))) (mutex-unlock! *db-transaction-mutex*) (if (and test-id state status (equal? status "AUTO")) @@ -4098,28 +4099,28 @@ (if (or (not waitons) (null? waitons)) '() (let* ((unmet-pre-reqs '()) (result '())) - (for-each + (for-each ;; waitons (lambda (waitontest-name) ;; by getting the tests with matching name we are looking only at the matching test ;; and related sub items ;; next should be using mt:get-tests-for-run? (let ((tests (db:get-tests-for-run-state-status dbstruct run-id waitontest-name)) (ever-seen #f) (parent-waiton-met #f) (item-waiton-met #f)) - (for-each + (for-each ;; item (test record) in waiton (lambda (test) ;; BB- this is the upstream test ;; (if (equal? waitontest-name (db:test-get-testname test)) ;; by defintion this had better be true ... (let* ((state (db:test-get-state test)) (status (db:test-get-status test)) (item-path (db:test-get-item-path test)) ;; BB- this is the upstream itempath (is-completed (equal? state "COMPLETED")) - (is-running (equal? state "RUNNING")) - (is-killed (equal? state "KILLED")) + (is-running (member state '("LAUNCHED" "REMOTEHOSTSTART" "RUNNING"))) + (is-killed (member state '("KILLREQ" "KILLING" "KILLED"))) (is-ok (member status ok-statuses)) ;; testname-b path-a path-b (same-itempath (db:compare-itempaths ref-test-name item-path ref-item-path itemmaps))) ;; (equal? ref-item-path item-path))) (set! ever-seen #t) (cond @@ -4146,15 +4147,30 @@ ((and is-completed (or is-ok (member 'toplevel mode)) ;; toplevel does not block on FAIL (and is-ok (member 'itemmatch mode))) ;; itemmatch blocks on not ok (set! item-waiton-met #t))))) - tests) + tests) ;; end of item for-each + + ;; both requirements, parent and item-waiton must be met to NOT add item to ;; prereq's not met list - (if (not (or parent-waiton-met item-waiton-met)) + + ;; is: + (if (not (or + (and (equal? ref-item-path "") parent-waiton-met) + item-waiton-met)) (set! result (append (if (null? tests) (list waitontest-name) tests) result))) ;; appends the string if the full record is not available + ;; was briefly: + ;; (if (not + ;; (and + ;; item-waiton-met + ;; (or parent-waiton-met (not (equal? ref-item-path ""))))) + ;; ;;add to list + ;; (set! result (append (if (null? tests) (list waitontest-name) tests) result))) ;; appends the string if the full record is not available + + ;; if the test is not found then clearly the waiton is not met... ;; (if (not ever-seen)(set! result (cons waitontest-name result))))) (if (not ever-seen) (set! result (append (if (null? tests)(list waitontest-name) tests) result))))) waitons) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -705,26 +705,27 @@ (unexpanded-prereqs (filter (lambda (testname) (let* ((test-rec (hash-table-ref test-records testname)) (items (tests:testqueue-get-items test-rec))) - (BB> "HEY " testname "=>"items) + ;;(BB> "HEY " testname "=>"items) (or (procedure? items)(eq? items 'have-procedure)))) waitons)) (completed-prereq-items - (let ((foo (begin (BB> "hello prereqs: "prereqs) #t)) + (let ((foo (begin ;;(BB> "hello prereqs: "prereqs) + #t)) (res (filter (lambda (test) - (BB> "foo - "test) + ;;(BB> "foo - "test) (and (vector? test) (equal? "COMPLETED" (db:test-get-state test)) (equal? "COMPLETED" (db:test-get-state test)) (not (equal? "" (db:test-get-item-path test))))) prereqs))) res)) ) - (debug:print-info 4 *default-log-port* "START OF INNER COND #2 " + (debug:print-info 1 *default-log-port* "START OF INNER COND #2 " "\n can-run-more: " can-run-more "\n testname: " hed "\n prereqs: " (runs:pretty-string prereqs) "\n completed-prereq-items: " (runs:pretty-string completed-prereq-items) "\n non-completed: " (runs:pretty-string non-completed) @@ -739,20 +740,20 @@ "\n unexpanded-prereqs: " unexpanded-prereqs ;;all-prereqs-expanded "\n completed-prereq-items: " completed-prereq-items "\n have-itemized: " have-itemized "\n can-run-more: " can-run-more) - (BB> "before runs:expand-items cond") + ;;(BB> "before runs:expand-items cond") (let ((res (cond ;; all prereqs met, fire off the test ;; or, if it is a 'toplevel test and all prereqs not met are COMPLETED then launch ;; runs:expand-items case: test of interest not toplevel and IS blackballed -> ??? ((and (not (member 'toplevel testmode)) ;; test has been blackballed elsewhere (member (hash-table-ref/default test-registry (db:test-make-full-name hed item-path) 'n/a) '(DONOTRUN removed CANNOTRUN))) ;; *common:cant-run-states-sym*) ;; '(COMPLETED KILLED WAIVED UNKNOWN INCOMPLETE)) ;; try to catch repeat processing of COMPLETED tests here - (BB> "cb1") + ;;(BB> "cb1") (debug:print-info 1 *default-log-port* "Test " hed " set to \"" (hash-table-ref test-registry (db:test-make-full-name hed item-path)) "\". Removing it from the queue") (if (or (not (null? tal)) (not (null? reg))) (runs:loop-values tal reg reglen regfull reruns) ;; blackballed test - throw it away @@ -783,11 +784,11 @@ ((or (and have-itemized (null? unexpanded-prereqs) (not (null? completed-prereq-items))) (null? prereqs) ;; nothing is in our way to proceed (need to expand this to an item level check.) (and (member 'toplevel testmode) ;; for toplevel test - proceed (nothing in our way) (null? non-completed))) - (BB> "cb2") + ;;(BB> "cb2") (debug:print-info 4 *default-log-port* "runs:expand-items: (or (null? prereqs) (and (member 'toplevel testmode)(null? non-completed)))") (let ((test-name (tests:testqueue-get-testname test-record))) (setenv "MT_TEST_NAME" test-name) ;; hack to give context to get-items-from-config TODO: call-with-environment-variables (setenv "MT_RUNNAME" runname) @@ -809,11 +810,11 @@ ;; runs:expand-items case: no fails, no prereq-fails, some non-completed ((and (null? fails) (null? prereq-fails) (not (null? non-completed))) - (BB> "cb3") + ;;(BB> "cb3") (let* ((allinqueue (map (lambda (x)(if (string? x) x (db:test-get-testname x))) (append newtal reruns))) ;; prereqstrs is a list of test names as strings that are prereqs for hed (prereqstrs (delete-duplicates (map (lambda (x)(if (string? x) x (db:test-get-testname x))) prereqs))) @@ -850,11 +851,11 @@ (list (car newtal)(append (cdr newtal) reg) '() reruns)))) ((and (null? fails) ;; have not-started tests, but unable to run them. everything looks completed with no prospect of unsticking something that is stuck. we should mark hed as moribund and exit or continue if there are more tests to consider (null? prereq-fails) (null? non-completed)) - (BB> "cb4") + ;;(BB> "cb4") (if (runs:can-keep-running? hed 20) (begin (runs:inc-cant-run-tests hed) (debug:print-info 0 *default-log-port* "no fails in prerequisites for " hed " but also none running, keeping " hed " for now. Try count: " (hash-table-ref/default *seen-cant-run-tests* hed 0)) ;; ;; getting here likely means the system is way overloaded, kill a full minute before continuing @@ -871,43 +872,48 @@ ((and (or (not (null? fails)) (not (null? prereq-fails))) (member 'normal testmode)) - (BB> "cb5") + ;;(BB> "cb5") (debug:print-info 1 *default-log-port* "test " hed " (mode=" testmode ") has failed prerequisite(s); " (string-intersperse (map (lambda (t)(conc (db:test-get-testname t) ":" (db:test-get-state t)"/"(db:test-get-status t))) fails) ", ") ", removing it from to-do list") (let ((test-id (rmt:get-test-id run-id hed ""))) (if test-id (if (not (null? prereq-fails)) - (mt:test-set-state-status-by-id run-id test-id "NOT_STARTED" "PREQ_DISCARDED" "Failed to run due to prior failed prerequisites") + ;;was: (mt:test-set-state-status-by-id run-id test-id "NOT_STARTED" "PREQ_DISCARDED" "Failed to run due to prior failed prerequisites") + (rmt:set-state-status-and-roll-up-items run-id test-id #f "NOT_STARTED" "PREQ_DISCARDED" "Failed to run due to prior failed prerequisites") (begin - (debug:print 4 *default-log-port*"BB> set PREQ_FAIL on "hed) - (mt:test-set-state-status-by-id run-id test-id "NOT_STARTED" "PREQ_FAIL" "Failed to run due to failed prerequisites"))))) ;; BB: this works, btu equivalent for itemwait mode does not work. + ;;(debug:print 4 *default-log-port*"BB> set PREQ_FAIL on "hed) + + + ;;was: (mt:test-set-state-status-by-id run-id test-id "NOT_STARTED" "PREQ_FAIL" "Failed to run due to failed prerequisites") + (rmt:set-state-status-and-roll-up-items run-id test-id #f "NOT_STARTED" "PREQ_FAIL" "Failed to run due to failed prerequisites") + )))) (if (or (not (null? reg))(not (null? tal))) (begin (hash-table-set! test-registry hed 'CANNOTRUN) (runs:loop-values tal reg reglen regfull (cons hed reruns)) ) #f)) ;; #f flags do not loop ((and (not (null? fails))(member 'toplevel testmode)) - (BB> "cb6") + ;;(BB> "cb6") (if (or (not (null? reg))(not (null? tal))) (list (car newtal)(append (cdr newtal) reg) '() reruns) #f)) ((null? runnable-prereqs) - (BB> "cb7") + ;;(BB> "cb7") #f) ;; if we get here and non-completed is null then it is all over. (else - (BB> "cb8") + ;;(BB> "cb8") (debug:print 0 *default-log-port* "WARNING: FAILS or incomplete tests maybe preventing completion of this run. Watch for issues with test " hed ", continuing for now") (list (car newtal)(cdr newtal) reg reruns))))) - (BB> "after runs:expand-items big cond") + ;;(BB> "after runs:expand-items big cond") res))) (define (runs:mixed-list-testname-and-testrec->list-of-strings inlst) (if (null? inlst) '() @@ -1122,12 +1128,15 @@ (if (or (vector? hed) (not (null? fails))) ;; BB: why do we need a vector? in my case, fails is populated (prereq failed), reg is not nul, and we really want to drop this one (begin (debug:print 1 *default-log-port* "WARNING: Dropping test " test-name "/" item-path " from the launch list as it has prerequistes that are FAIL") (let ((test-id (rmt:get-test-id run-id hed ""))) - (if test-id (mt:test-set-state-status-by-id run-id test-id "NOT_STARTED" "PREQ_FAIL" "Failed to run due to failed prerequisites"))) - (runs:shrink-can-run-more-tests-count runsdat) ;; DELAY TWEAKER (still needed?) + (if test-id + ;; was: ;(mt:test-set-state-status-by-id run-id test-id "NOT_STARTED" "PREQ_FAIL" "Failed to run due to failed prerequisites"))) + (rmt:set-state-status-and-roll-up-items run-id test-id #f "NOT_STARTED" "PREQ_FAIL" "Failed to run due to failed prerequisites"))) + + (runs:shrink-can-run-more-tests-count runsdat) ;; DELAY TWEAKER (still needed?) ;; (thread-sleep! *global-delta*) ;; This next is for the items (if (not (null? fails)) ;;(mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "PREQ_FAIL" #f)