Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -173,10 +173,11 @@ (keyvals (keys:target->keyval keys target)) (run-id (rmt:register-run keyvals runname "new" "n/a" user)) ;; test-name))) ;; (deferred '()) ;; delay running these since they have a waiton clause (runconfigf (conc *toppath* "/runconfigs.config")) (test-records (make-hash-table)) + (test-deps (make-hash-table)) ;; need to process runconfigs before generating these lists (all-tests-registry #f) ;; (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names (all-test-names #f) ;; (hash-table-keys all-tests-registry)) (test-names #f) ;; Generated by a call to (tests:filter-test-names all-test-names test-patts)) (required-tests #f) ;; Put fully qualified test/testpath names in this list to be done @@ -232,11 +233,11 @@ ;; Now generate all the tests lists (set! all-tests-registry (tests:get-all)) ;; hash of testname => path-to-test (set! all-test-names (hash-table-keys all-tests-registry)) (set! test-names (tests:filter-test-names all-test-names test-patts)) - + ;; I think seeding required-tests with all test-names makes sense but lack analysis to back that up. ;; NEW STRATEGY HERE: ;; 1. fill required tests with test-patts ;; 2. scan testconfigs and if waitons, itemwait, itempatt calc prior test test-patt @@ -322,12 +323,15 @@ (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")) + (mode (tests:get-mode config)) (new-test-patts (tests:extend-test-patts test-patts hed waiton itemmaps))) (debug:print-info 0 "Test " waiton " has " (if waiton-record "a" "no") " waiton-record and" (if waiton-itemized " " " no ") "items") + ;;(debug:print-info 0 "BB> Test is "hed" test-patts is "test-patts) + ;;(debug:print-info 0 "BB> waiton is " waiton " mode is " mode" and new-test-patts is "new-test-patts) ;; 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? ;; ;; This approach causes all of the items in an upstream test to be run @@ -335,39 +339,69 @@ ;; if we have this waiton already processed once we can analzye it for extending ;; tests to be run, since we can't properly process waitons unless they have been ;; initially added we add them again to be processed on second round AND add the hed ;; back in to also be processed on second round ;; - (if waiton-tconfig - (begin - (set! test-names (cons waiton test-names)) ;; need to process this one, only add once the waiton tconfig read - (if waiton-itemized - (begin - (debug:print-info 0 "New test patts: " new-test-patts ", prev test patts: " test-patts) - (set! required-tests (cons (conc waiton "/") required-tests)) - (set! test-patts new-test-patts)) - (begin - (debug:print-info 0 "Adding non-itemized test " waiton " to required-tests") - (set! required-tests (cons waiton required-tests)) - (set! test-patts new-test-patts)))) - (begin - (debug:print-info 0 "No testconfig info yet for " waiton ", setting up to re-process it") - (set! tal (append (cons waiton tal)(list hed))))) ;; (cons (conc waiton "/") required-tests)) - + + ;;(debug:print-info 0 "BB> remaining tests: "tal) + (let ((hed-depended-on-by-remaining-test + ;; BB>> don't set testpatt if hed is waited on by another test in testnames + + (foldr + (lambda (remaining-test previous-result) + (let ((dependencies-on-remaining-test + (hash-table-ref/default test-deps remaining-test '())) + (mode (tests:get-mode config))) + ;;(debug:print-info 0 "BB> remaining-test="remaining-test" dependencies-on-remaining-test: "dependencies-on-remaining-test) + (or previous-result + (if (or + (not (equal? "itemwait" mode)) + (member hed dependencies-on-remaining-test)) + #t + #f)))) + #f + tal))) + + ;;(debug:print-info 0 "BB> hed="hed" hed-depended-on-by-remaining-test="hed-depended-on-by-remaining-test) + (if (and waiton-tconfig (not hed-depended-on-by-remaining-test)) + (begin + (set! test-names (cons waiton test-names)) ;; need to process this one, only add once the waiton tconfig read + (if waiton-itemized + (begin + (debug:print-info 0 "New test patts: " new-test-patts ", prev test patts: " test-patts) + (set! required-tests (cons (conc waiton "/") required-tests)) + ;;(debug:print-info 0 "BB> set1 test-patts <- " test-patts) + (set! test-patts new-test-patts)) + (begin + (debug:print-info 0 "Adding non-itemized test " waiton " to required-tests") + (set! required-tests (cons waiton required-tests)) + ;;(debug:print-info 0 "BB> set2 test-patts <- " test-patts) + (set! test-patts new-test-patts)))) + (begin + (debug:print-info 0 "No testconfig info yet for " waiton ", setting up to re-process it") + (set! tal (append (cons waiton tal)(list hed)))))) ;; (cons (conc waiton "/") required-tests)) + ;; NOPE: didn't work. required needs to be plain test names. Try tacking on to test-patts ;; - doesn't work ;; (set! test-patts (conc test-patts "," waiton "/")) ;; (set! test-names (cons waiton test-names))))) ;; was an append, now a cons ))) (delete-duplicates (append waitons waitors))) + + ;; remember deps + (hash-table-set! + test-deps + hed + (delete-duplicates (append waitons waitors (hash-table-ref/default test-deps hed '())))) + (let ((remtests (delete-duplicates (append waitons tal)))) (if (not (null? remtests)) (begin ;; (debug:print-info 0 "Preprocessing continues for " (string-intersperse remtests ", ")) (loop (car remtests)(cdr remtests)))))))) - + (if (not (null? required-tests)) (debug:print-info 1 "Adding \"" (string-intersperse required-tests " ") "\" to the run queue")) ;; NOTE: these are all parent tests, items are not expanded yet. (debug:print-info 4 "test-records=" (hash-table->alist test-records)) (let ((reglen (configf:lookup *configdat* "setup" "runqueue"))) Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -91,10 +91,14 @@ (list (list "%" base-itemmap)) '()) (if itemmap-table itemmap-table '())))) + +(define (tests:get-mode tconfig) + (let ((itemwait (configf:lookup tconfig "requirements" "mode"))) + itemwait)) ;; given a list of itemmaps (testname . map), return the first match ;; (define (tests:lookup-itemmap itemmaps testname) (let ((best-matches (filter (lambda (itemmap)