Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -531,17 +531,22 @@
(5 "WAIVED")
(6 "CHECK")
(7 "STUCK/DEAD")
(8 "DEAD")
(9 "FAIL")
- (10 "ABORT")))
+ (10 "PREQ_FAIL")
+ (11 "PREQ_DISCARDED")
+ (12 "ABORT")))
(define *common:ended-states* ;; states which indicate the test is stopped and will not proceed
- '("COMPLETED" "ARCHIVED" "KILLED" "KILLREQ" "STUCK" "INCOMPLETE"))
+ '("COMPLETED" "ARCHIVED" "KILLED" "KILLREQ" "STUCK" "INCOMPLETE" ))
(define *common:badly-ended-states* ;; these roll up as CHECK, i.e. results need to be checked
'("KILLED" "KILLREQ" "STUCK" "INCOMPLETE" "DEAD"))
+
+(define *common:well-ended-states* ;; an item's prereq in this state allows item to proceed
+ '("PASS" "WARN" "CHECK" "WAIVED" "SKIP"))
;; BBnote: *common:running-states* used from db:set-state-status-and-roll-up-items
(define *common:running-states* ;; test is either running or can be run
'("RUNNING" "REMOTEHOSTSTART" "LAUNCHED" "STARTED"))
Index: common_records.scm
==================================================================
--- common_records.scm
+++ common_records.scm
@@ -147,15 +147,17 @@
(temp (string-split (->string this-loc) " "))
(this-func (if (and (list? temp) (> (length temp) 1)) (cadr temp) "???")))
(if (equal? this-func "BB>")
(set! location this-loc))))
stack)
- (let ((dp-args
- (append
- (list 0 *default-log-port*
- (conc location "@"(/ (- (current-milliseconds) *BB-process-starttime*) 1000)" ") )
- in-args)))
+ (let* ((color-on "\x1b[1m")
+ (color-off "\x1b[0m")
+ (dp-args
+ (append
+ (list 0 *default-log-port*
+ (conc color-on location "@"(/ (- (current-milliseconds) *BB-process-starttime*) 1000) color-off " ") )
+ in-args)))
(apply debug:print dp-args))))
(define *BBpp_custom_expanders_list* (make-hash-table))
Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -1581,17 +1581,17 @@
;; select end_time-now from
;; (select testname,item_path,event_time+run_duration as
;; end_time,strftime('%s','now') as now from tests where state in
-;; ('RUNNING','REMOTEHOSTSTART','LAUNCED'));
+;; ('RUNNING','REMOTEHOSTSTART','LAUNCHED'));
(define (db:find-and-mark-incomplete dbstruct run-id ovr-deadtime)
(let* ((incompleted '())
(oldlaunched '())
(toplevels '())
- (deadtime-str (configf:lookup *configdat* "setup" "deadtime"))
+ (deadtime-str (configf:lookup *configdat* "setup" "deadtime")) ; FIXME suspect test run time & deadtime are not well matched; resulting in COMPLETED/DEAD status of an a-ok running test
(deadtime (if (and deadtime-str
(string->number deadtime-str))
(string->number deadtime-str)
7200))) ;; two hours
(db:with-db
@@ -1650,11 +1650,11 @@
(if (> (length all-ids) 0)
(begin
(debug:print 0 *default-log-port* "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ") " as INCOMPLETE")
(for-each
(lambda (test-id)
- (db:test-set-state-status dbstruct run-id test-id "COMPLETED" "DEAD" "Test failed to complete")) ;; fix for one aspect of Randy's ticket 1405717332
+ (db:test-set-state-status dbstruct run-id test-id "COMPLETED" "DEAD" "Test failed to complete")) ;; fix for one aspect of Randy's ticket 1405717332 ;; TODO - fix problem where test goes to COMPLETED/DEAD while in progress, only later to go to COMPLETED/PASS. ref ticket 220546828
all-ids))))))))
;; ALL REPLACED BY THE BLOCK ABOVE
;;
;; (sqlite3:execute
@@ -4116,72 +4116,125 @@
;; (conc (db:test-get-testname testdat)
;; "/"
;; (db:test-get-item-path testdat))))
running-tests) ;; calling functions want the entire data
'())
+
+ ;; collection of: for each waiton -
+ ;; if this ref-test-name is an item in an itemized test and mode is itemwait/itemmatch:
+ ;; if waiton is not itemized - if waiton is not both completed and in ok status, add as unmet prerequisite
+ ;; if waiton is itemized:
+ ;; and waiton's items are not expanded, add as unmet prerequisite
+ ;; else if matching waiton item is not both completed and in an ok status, add as unmet prerequisite
+ ;; else
+ ;; if waiton toplevel is not in both completed and ok status, add as unmet prerequisite
+
(if (or (not waitons)
(null? waitons))
'()
- (let* ((unmet-pre-reqs '())
- (result '()))
- (for-each
+ (let* ((ref-test-itemized-mode (not (null? (lset-intersection eq? mode '(itemmatch itemwait)))))
+ (ref-test-toplevel-mode (not (null? (lset-intersection eq? mode '(toplevel)))))
+ (ref-test-is-toplevel (equal? ref-item-path ""))
+ (ref-test-is-item (not ref-test-is-toplevel))
+ (unmet-pre-reqs '())
+ (result '())
+ (unmet-prereq-items '())
+ )
+ (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))
+
+ (let (;(waiton-is-itemized ...)
+ ;(waiton-items-are-expanded ...)
+ (waiton-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
- (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-ok (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))
+ (item-waiton-met #f)
+
+ )
+ (for-each ; test expanded from waiton
+ (lambda (waiton-test)
+ (let* ((waiton-state (db:test-get-state waiton-test))
+ (waiton-status (db:test-get-status waiton-test))
+ (waiton-item-path (db:test-get-item-path waiton-test)) ;; BB- this is the upstream itempath
+ (waiton-is-toplevel (equal? waiton-item-path ""))
+ (waiton-is-item (not waiton-is-toplevel))
+ (waiton-is-completed (member waiton-state *common:ended-states*))
+ (waiton-is-running (member waiton-state *common:running-states*))
+ (waiton-is-killed (member waiton-state *common:badly-ended-states*))
+ (waiton-is-ok (member waiton-status *common:well-ended-states*))
;; 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)))
+ (same-itempath (db:compare-itempaths ref-test-name waiton-item-path ref-item-path itemmaps))) ;; (equal? ref-item-path waiton-item-path)))
(set! ever-seen #t)
- (cond
- ;; case 1, non-item (parent test) is
- ((and (equal? item-path "") ;; this is the parent test of the waiton being examined
- is-completed
- (or is-ok (not (null? (lset-intersection eq? mode '(toplevel)))))) ;; itemmatch itemwait))))))
+ ;;(BB> "***consider waiton "waiton-test"/"waiton-item-path"***")
+ (cond
+ ;; case 0 - toplevel of an itemized test, at least one item in prereq has completed
+ ((and waiton-is-item ref-test-is-toplevel ref-test-itemized-mode waiton-is-completed)
+ (set! parent-waiton-met #t))
+
+ ;; case 1, non-item (parent test) is
+ ((and waiton-is-toplevel ;; this is the parent test of the waiton being examined
+ waiton-is-completed
+ ;;(BB> "cond1")
+ (or waiton-is-ok ref-test-toplevel-mode)) ;; itemmatch itemwait))))))
(set! parent-waiton-met #t))
;; Special case for toplevel and KILLED
- ((and (equal? item-path "") ;; this is the parent test
- is-killed
+ ((and waiton-is-toplevel ;; this is the parent test
+ waiton-is-killed
(member 'toplevel mode))
+ ;;(BB> "cond2")
(set! parent-waiton-met #t))
;; For itemwait mode IFF the previous matching item is good the set parent-waiton-met
- ((and (not (null? (lset-intersection eq? mode '(itemmatch itemwait)))) ;; how is that different from (member mode '(itemmatch itemwait)) ?????
- ;; (not (equal? item-path "")) ;; this applies to both top level (to allow launching of next batch) and items
- same-itempath)
- (if (and is-completed is-ok)
- (set! item-waiton-met #t))
- (if (and (equal? item-path "") ;; if upstream rollup test is completed, parent-waiton-met is set
- (or is-completed is-running));; this is the parent, set it to run if completed or running ;; BB1
+ ((and ref-test-itemized-mode ref-test-is-item same-itempath)
+ ;;(BB> "cond3")
+ (if (and waiton-is-completed (or waiton-is-ok ref-test-toplevel-mode))
+ (set! item-waiton-met #t)
+ (set! unmet-prereq-items (cons waiton-test unmet-prereq-items)))
+ (if (and waiton-is-toplevel ;; if upstream rollup test is completed, parent-waiton-met is set
+ (or waiton-is-completed waiton-is-running))
(set! parent-waiton-met #t)))
;; normal checking of parent items, any parent or parent item not ok blocks running
- ((and is-completed
- (or is-ok
+ ((and waiton-is-completed
+ (or waiton-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)
+ (and waiton-is-ok (member 'itemmatch mode) ;; itemmatch blocks on not ok
+ ))
+ ;;(BB> "cond4")
+ (set! item-waiton-met #t))
+
+ ((and waiton-is-completed waiton-is-ok same-itempath)
+ ;;(BB> "cond5")
+ (set! item-waiton-met #t))
+ (else
+ #t
+ ;;(BB> "condelse")
+ ))))
+ waiton-tests)
;; 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))
- (set! result (append (if (null? tests) (list waitontest-name) tests) result))) ;; appends the string if the full record is not available
+ ;; (BB>
+ ;; "\n* waiton-tests "waiton-tests
+ ;; "\n* parent-waiton-met "parent-waiton-met
+ ;; "\n* item-waiton-met "item-waiton-met
+ ;; "\n* ever-seen "ever-seen
+ ;; "\n* ref-test-itemized-mode "ref-test-itemized-mode
+ ;; "\n* unmet-prereq-items "unmet-prereq-items
+ ;; "\n* result (pre) "result
+ ;; "\n* ever-seen "ever-seen
+ ;; "\n")
+
+ (cond
+ ((and ref-test-itemized-mode ref-test-is-item (not (null? unmet-prereq-items)))
+ (set! result (append unmet-prereq-items result)))
+ ((not (or parent-waiton-met item-waiton-met))
+ (set! result (append (if (null? waiton-tests) (list waitontest-name) waiton-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)))))
+ ((not ever-seen)
+ (set! result (append (if (null? waiton-tests)(list waitontest-name) waiton-tests) result))))))
waitons)
(delete-duplicates result)))))
;;======================================================================
;; Just for sync, procedures to make sync easy
Index: gutils.scm
==================================================================
--- gutils.scm
+++ gutils.scm
@@ -36,10 +36,11 @@
;; ((if get-label cadr car)
(case (string->symbol state)
((COMPLETED) ;; ARCHIVED)
(case (string->symbol status)
((PASS) (list "70 249 73" status))
+ ((PREQ_FAIL PREQ_DISCARDED) (list "255 127 127" status))
((WARN WAIVED) (list "255 172 13" status))
((SKIP) (list (gutils:get-color-spec 'SKIP) status))
((ABORT) (list "198 36 166" status))
(else (list "253 33 49" status))))
((ARCHIVED)
Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -1592,11 +1592,11 @@
(lambda (target runname keys keyvals)
(if (args:get-arg "-rerun-clean") ;; first set states/statuses correct
(let ((states (or (configf:lookup *configdat* "validvalues" "cleanrerun-states")
"KILLREQ,KILLED,UNKNOWN,INCOMPLETE,STUCK,NOT_STARTED"))
(statuses (or (configf:lookup *configdat* "validvalues" "cleanrerun-statuses")
- "FAIL,INCOMPLETE,ABORT,CHECK,DEAD")))
+ "FAIL,INCOMPLETE,ABORT,CHECK,DEAD,PREQ_FAIL,PREQ_DISCARDED")))
(hash-table-set! args:arg-hash "-preclean" #t)
(runs:operate-on 'set-state-status
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
"%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -192,11 +192,12 @@
(args:get-arg "-one-pass"))
(exit 0))
(thread-sleep! (cond
((> (runs:dat-can-run-more-tests-count runsdat) 20)
(if (runs:lownoise "waiting on tasks" 60)(debug:print-info 2 *default-log-port* "waiting for tasks to complete, sleeping briefly ..."))
- 2);; obviously haven't had any work to do for a while
+ (configf:lookup-number *configdat* "setup" "inter-test-delay" default: 2) ;; was 2
+ );; obviously haven't had any work to do for a while
(else 0)))
(let* ((num-running (rmt:get-count-tests-running run-id))
(num-running-in-jobgroup (rmt:get-count-tests-running-in-jobgroup run-id jobgroup))
(job-group-limit (let ((jobg-count (config-lookup *configdat* "jobgroups" jobgroup)))
(if (string? jobg-count)
@@ -502,11 +503,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)))
+ (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?
;;
@@ -542,11 +543,11 @@
(delete-duplicates (append waitons waitors)))
(let ((remtests (delete-duplicates (append waitons tal))))
(if (not (null? remtests))
(begin
;; (debug:print-info 0 *default-log-port* "Preprocessing continues for " (string-intersperse remtests ", "))
- (loop (car remtests)(cdr remtests))))))))
+ (loop (car remtests)(cdr remtests)))))))) ;; end test-names loop
(if (not (null? required-tests))
(debug:print-info 1 *default-log-port* "Adding \"" (string-intersperse required-tests " ") "\" to the run queue"))
;; NOTE: these are all parent tests, items are not expanded yet.
(debug:print-info 4 *default-log-port* "test-records=" (hash-table->alist test-records))
@@ -604,25 +605,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
@@ -631,12 +632,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)
@@ -644,16 +658,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 2 *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)
@@ -686,11 +711,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)))
@@ -741,11 +775,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)
@@ -779,12 +813,12 @@
(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")
- (mt:test-set-state-status-by-id run-id test-id "NOT_STARTED" "PREQ_FAIL" "Failed to run due to failed prerequisites"))))
+ (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"))))
(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))
)
@@ -855,11 +889,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!
@@ -1004,17 +1038,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 (vector? hed)
+ (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
(mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "BLOCKED" #f)
(hash-table-set! test-registry (db:test-make-full-name test-name item-path) 'removed)
@@ -1022,15 +1062,15 @@
(let ((nth-try (hash-table-ref/default test-registry hed 0)))
(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)
(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"))
@@ -1043,13 +1083,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)
@@ -1058,15 +1101,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)
@@ -1414,11 +1462,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))))
@@ -1473,16 +1521,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")))))