@@ -501,11 +501,11 @@ (waiton-tconfig (if waiton-record (vector-ref waiton-record 1) #f)) (waiton-itemized (and waiton-tconfig (or (hash-table-ref/default waiton-tconfig "items" #f) (hash-table-ref/default waiton-tconfig "itemstable" #f)))) (itemmaps (tests:get-itemmaps config)) ;; (configf:lookup config "requirements" "itemmap")) - (new-test-patts (tests:extend-test-patts test-patts hed waiton itemmaps))) ;; BB: items expanded here. + (new-test-patts (tests:extend-test-patts test-patts hed waiton itemmaps))) ;; BB: items expanded here (debug:print-info 0 *default-log-port* "Test " waiton " has " (if waiton-record "a" "no") " waiton-record and" (if waiton-itemized " " " no ") "items") ;; need to account for test-patt here, if I am test "a", selected with a test-patt of "hed/b%" ;; and we are waiting on "waiton" we need to add "waiton/,waiton/b%" to test-patt ;; is this satisfied by merely appending "/" to the waiton name added to the list? ;; @@ -603,25 +603,25 @@ ;; but have items in reg; loop with (car reg)(cdr reg) '() reruns ;; If reg is empty => all done (define (runs:queue-next-hed tal reg n regfull) (if regfull - (car reg) + (if (null? reg) #f (car reg)) (if (null? tal) ;; tal is used up, pop from reg - (car reg) + (if (null? reg) #f (car reg)) (car tal)))) (define (runs:queue-next-tal tal reg n regfull) (if regfull tal (if (null? tal) ;; must transfer from reg - (cdr reg) + (if (null? reg) '() (cdr reg)) (cdr tal)))) (define (runs:queue-next-reg tal reg n regfull) (if regfull - (cdr reg) + (if (null? reg) '() (cdr reg)) (if (null? tal) ;; if tal is null and reg not full then '() as reg contents moved to tal '() reg))) ;; this is the list of parameters to the named loop "loop" near the top of runs:run-tests-queue, look around line 1216 @@ -630,12 +630,25 @@ (list (runs:queue-next-hed tal reg reglen regfull) ;; hed (runs:queue-next-tal tal reg reglen regfull) ;; tal (runs:queue-next-reg tal reg reglen regfull) ;; reg reruns)) ;; reruns +;; objective - iterate thru tests +;; => want to prioritize tests we haven't seen before +;; => sometimes need to squeeze things in (added to reg) +;; => review of a previously seen test is higher priority of never visited test +;; reg - list of previously visited tests +;; tal - list of never visited tests +;; prefer next hed to be from reg than tal. + (define runs:nothing-left-in-queue-count 0) +;; return value of runs:expand-items is passed back to runs-tests-queue and is fed to named loop with this signature: +;; (let loop ((hed (car sorted-test-names)) +;; (tal (cdr sorted-test-names)) +;; (reg '()) ;; registered, put these at the head of tal +;; (reruns '())) ;; BB: for future reference - suspect target vars are not expanded to env vars at this point (item expansion using [items]\nwhatever [system echo $TARGETVAR] doesnt work right whereas [system echo #{targetvar}] does.. Tal and Randy have tix on this. on first pass, var not set, on second pass, ok. (define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmaps) (let* ((loop-list (list hed tal reg reruns)) (prereqs-not-met (let ((res (rmt:get-prereqs-not-met run-id waitons hed item-path mode: testmode itemmaps: itemmaps))) (if (list? res) @@ -643,16 +656,27 @@ (begin (debug:print 0 *default-log-port* "ERROR: rmt:get-prereqs-not-met returned non-list!\n" " res=" res " run-id=" run-id " waitons=" waitons " hed=" hed " item-path=" item-path " testmode=" testmode " itemmaps=" itemmaps) '())))) + (have-itemized (not (null? (lset-intersection eq? testmode '(itemmatch itemwait))))) ;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap)) (fails (runs:calc-fails prereqs-not-met)) (prereq-fails (runs:calc-prereq-fail prereqs-not-met)) (non-completed (runs:calc-not-completed prereqs-not-met)) - (runnables (runs:calc-runnable prereqs-not-met))) - (debug:print-info 4 *default-log-port* "START OF INNER COND #2 " + (runnables (runs:calc-runnable prereqs-not-met)) + (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) + (or (procedure? items)(eq? items 'have-procedure)))) + waitons)) + + + ) + (debug:print-info 1 *default-log-port* "START OF INNER COND #2 " "\n can-run-more: " can-run-more "\n testname: " hed "\n prereqs-not-met: " (runs:pretty-string prereqs-not-met) "\n non-completed: " (runs:pretty-string non-completed) "\n prereq-fails: " (runs:pretty-string prereq-fails) @@ -685,11 +709,20 @@ (debug:print 0 *default-log-port* "WARNING: this condition is triggered when there were no items to expand and nothing to run. Please check your run for completeness") (exit 0)) (set! runs:nothing-left-in-queue-count (+ runs:nothing-left-in-queue-count 1))) #f))) - ;; + ;; desired result of below cond branch: + ;; we want to expand items in our test of interest (hed) in the following cases: + ;; case 1 - mode is itemmatch or itemwait: + ;; - all prereq tests have been expanded + ;; - at least one prereq's items have completed + ;; case 2 - mode is toplevel + ;; - prereqs are completed. + ;; - or no prereqs can complete + ;; case 3 - mode not specified + ;; - prereqs are completed and passed (we could consider removing "and passed" -- it would change behavior from current) ((or (null? prereqs-not-met) (and (member 'toplevel testmode) (null? non-completed))) (debug:print-info 4 *default-log-port* "runs:expand-items: (or (null? prereqs-not-met) (and (member 'toplevel testmode)(null? non-completed)))") (let ((test-name (tests:testqueue-get-testname test-record))) @@ -740,11 +773,11 @@ (let ((trimmed-tal (mt:discard-blocked-tests run-id hed tal test-records)) (trimmed-reg (mt:discard-blocked-tests run-id hed reg test-records))) (debug:print 1 *default-log-port* "WARNING: test " hed " has discarded prerequisites, removing it from the queue") (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_DISCARDED" "Failed to run due to discarded prerequisites"))) + (if test-id (mt:test-set-state-status-by-id run-id test-id "COMPLETED" "PREQ_DISCARDED" "Failed to run due to discarded prerequisites"))) (if (and (null? trimmed-tal) (null? trimmed-reg)) #f (runs:loop-values trimmed-tal trimmed-reg reglen regfull reruns) @@ -778,21 +811,21 @@ (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") - (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. + (mt:test-set-state-status-by-id run-id test-id "COMPLETED" "PREQ_DISCARDED" "Failed to run due to prior failed prerequisites") + (mt:test-set-state-status-by-id run-id test-id "COMPLETED" "PREQ_FAIL" "Failed to run due to failed prerequisites")))) + ;; (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. (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)) (if (or (not (null? reg))(not (null? tal))) (list (car newtal)(append (cdr newtal) reg) '() reruns) #f)) ((null? runnables) #f) ;; if we get here and non-completed is null then it is all over. @@ -859,11 +892,11 @@ (num-running-in-jobgroup(list-ref run-limits-info 2)) (max-concurrent-jobs (list-ref run-limits-info 3)) (job-group-limit (list-ref run-limits-info 4)) ;; (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons hed item-path mode: testmode itemmaps: itemmaps)) ;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap)) - (fails (if (list? prereqs-not-met) + (fails (if (list? prereqs-not-met) ;; TODO: rename fails to failed-prereqs (runs:calc-fails prereqs-not-met) (begin (debug:print-error 0 *default-log-port* "prereqs-not-met is not a list! " prereqs-not-met) '()))) (non-completed (filter (lambda (x) ;; remove hed from not completed list, duh, of course it is not completed! @@ -1008,17 +1041,23 @@ (if (runs:lownoise "Waiting for more work to do..." 60) (debug:print-info 0 *default-log-port* "Waiting for more work to do...")) (thread-sleep! 1) (list (car newtal)(cdr newtal) reg reruns)) ;; the waiton is FAIL so no point in trying to run hed ever again - (if (or (not (null? reg))(not (null? tal))) - (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 + (let ((my-test-id (rmt:get-test-id run-id test-name item-path))) + (mt:test-set-state-status-by-id run-id my-test-id "COMPLETED" "PREQ_FAIL" "Failed to run due to failed prerequisites2")) + + + + (if (or (not (null? reg))(not (null? tal))) + (if (vector? hed) (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"))) + (if test-id (mt:test-set-state-status-by-id run-id test-id "COMPLETED" "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)) @@ -1032,15 +1071,15 @@ (debug:print 2 *default-log-port* "nth-try("hed")="nth-try) (cond ((member "RUNNING" (map db:test-get-state prereqs-not-met)) (if (runs:lownoise (conc "possible RUNNING prerequistes " hed) 60) (debug:print 0 *default-log-port* "WARNING: test " hed " has possible RUNNING prerequisites, don't give up on it yet.")) - (thread-sleep! 4) + (thread-sleep! 0.1) (runs:loop-values tal reg reglen regfull reruns)) ((or (not nth-try) ;; BB: condition on subsequent tries, condition below fires on first try (and (number? nth-try) - (< nth-try 10))) + (< nth-try 2))) (hash-table-set! test-registry hed (if (number? nth-try) (+ nth-try 1) 0)) (if (runs:lownoise (conc "not removing test " hed) 60) (debug:print 1 *default-log-port* "WARNING: not removing test " hed " from queue although it may not be runnable due to FAILED prerequisites")) @@ -1053,13 +1092,16 @@ #f ;; yes, really (list (car tal)(cdr tal) reg reruns)) (begin (if (runs:lownoise (conc "FAILED prerequisites or other issue" hed) 60) (debug:print 0 *default-log-port* "WARNING: test " hed " has FAILED prerequisites or other issue. Internal state >" nth-try "< will be overridden and we'll retry.")) - (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "KEEP_TRYING" #f) - (hash-table-set! test-registry hed 0) - (runs:loop-values newtal reg reglen regfull reruns)))) + ;; was: (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "KEEP_TRYING" #f) + (mt:test-set-state-status-by-testname run-id test-name item-path "COMPLETED" "PREQ_FAIL" #f) + (hash-table-set! test-registry hed 'removed) ;; was 0 + (if (not (and (null? reg) (null? tal))) + (runs:loop-values tal reg reglen regfull reruns) + #f)))) (else (if (runs:lownoise (conc "FAILED prerequitests and we tried" hed) 60) (debug:print 0 *default-log-port* "WARNING: test " hed " has FAILED prerequitests and we've tried at least 10 times to run it. Giving up now.")) ;; (debug:print 0 *default-log-port* " prereqs: " prereqs-not-met) (hash-table-set! test-registry hed 'removed) @@ -1068,15 +1110,20 @@ (rmt:set-state-status-and-roll-up-items run-id test-name item-path #f "FAIL" #f) ;; treat as FAIL (list (if (null? tal)(car newtal)(car tal)) tal reg reruns))))) - ;; can't drop this - maybe running? Just keep trying - (let ((runable-tests (runs:runable-tests prereqs-not-met))) ;; SUSPICIOUS: Should look at more than just prereqs-not-met? - (if (null? runable-tests) - #f ;; I think we are truly done here - (runs:loop-values newtal reg reglen regfull reruns))))))))) + ;; ELSE: can't drop this - maybe running? Just keep trying + + ;;(if (not (or (not (null? reg))(not (null? tal)))) ;; old experiment + (let ((runable-tests (runs:runable-tests prereqs-not-met))) ;; SUSPICIOUS: Should look at more than just prereqs-not-met? + (if (null? runable-tests) + #f ;; I think we are truly done here + (runs:loop-values newtal reg reglen regfull reruns))) + ;;) ;;from old experiment + ) ;; end if (or (not (null? reg))(not (null? tal))) + )))))) ;; scan a list of tests looking to see if any are potentially runnable ;; (define (runs:runable-tests tests) (filter (lambda (t) @@ -1319,11 +1366,11 @@ (runs:queue-next-reg tal reg reglen regfull) reruns)))) ;; (loop (car tal)(cdr tal) reg reruns)))) (runs:incremental-print-results run-id) - (debug:print 4 *default-log-port* "TOP OF LOOP => " + (debug:print 1 *default-log-port* "TOP OF LOOP => " "test-name: " test-name "\n test-record " test-record "\n hed: " hed "\n itemdat: " itemdat "\n items: " items @@ -1424,11 +1471,11 @@ ;; EXPAND ITEMS ((or (procedure? items)(eq? items 'have-procedure)) ;; BB - target vars are env vars here? to allow expansion of [items]\nsomething [system echo $SOMETARGVAR], which is wonky (let ((can-run-more (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs))) (if (and (list? can-run-more) (car can-run-more)) - (let ((loop-list (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmaps))) + (let ((loop-list (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmaps))) ;; itemized test expanded here (if loop-list (apply loop loop-list))) ;; if can't run more just loop with next possible test (loop (car newtal)(cdr newtal) reg reruns)))) @@ -1484,16 +1531,16 @@ (debug:print-info 1 *default-log-port* "All tests launched"))) (define (runs:calc-fails prereqs-not-met) (filter (lambda (test) (and (vector? test) ;; not (string? test)) - (member (db:test-get-state test) '("INCOMPLETE" "COMPLETED")) + (member (db:test-get-state test) '("INCOMPLETE" "COMPLETED")) ;; TODO: pull from *common:stuff...* (not (member (db:test-get-status test) '("PASS" "WARN" "CHECK" "WAIVED" "SKIP"))))) prereqs-not-met)) -(define (runs:calc-prereq-fail prereqs-not-met) +(define (runs:calc-prereq-fail prereqs-not-met) ;; REMOVEME since NOT_STARTED/PREQ_FAIL is now COMPLETED/PREQ_FAIL (filter (lambda (test) (and (vector? test) ;; not (string? test)) (equal? (db:test-get-state test) "NOT_STARTED") (not (member (db:test-get-status test) '("n/a" "KEEP_TRYING")))))