Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -306,10 +306,18 @@
(debug:print 0 *default-log-port* "ERROR: failed to run post-hook " run-post-hook ", check the log " log-file))
(debug:print-info 0 *default-log-port* "running run-post-hook: \"" run-post-hook "\", log is " actual-logf)
(system (conc run-post-hook " >> " actual-logf " 2>&1"))
(debug:print-info 0 *default-log-port* "post-hook \"" run-post-hook "\" took " (- (current-seconds) start-time) " seconds to run."))))))
+
+(define (runs:make-sure-all-waitors-upon-are-in-testpatts testpatts waitors-upon)
+
+ (print "NOT IMPLEMENTED")
+ (exit 1)
+
+ #f)
+
;; test-names: Comma separated patterns same as test-patts but used in selection
;; of tests to run. The item portions are not respected.
;; FIXME: error out if /patt specified
;;
(define (runs:run-tests target runname test-patts user flags #!key (run-count 1)) ;; test-names
@@ -324,10 +332,11 @@
;; 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
+ (waitors-upon (make-hash-table)) ;; given a test, return list of tests waiting upon this test.
(task-key (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
;; (tdbdat (tasks:open-db))
(config-reruns (let ((x (configf:lookup *configdat* "setup" "reruns")))
(if x (string->number x) #f)))
(allowed-tests #f))
@@ -471,11 +480,12 @@
(if (not (null? test-names))
(let loop ((hed (car test-names)) ;; NOTE: This is the main loop that iterates over the test-names
(tal (cdr test-names))) ;; 'return-procs tells the config reader to prep running system but return a proc
(change-directory *toppath*) ;; PLEASE OPTIMIZE ME!!! I think this should be a no-op but there are several places where change-directories could be happening.
(setenv "MT_TEST_NAME" hed) ;;
- (let*-values (((waitons waitors config)(tests:get-waitons hed all-tests-registry)))
+ (let*-values (((waitons waitors config)
+ (tests:get-waitons hed all-tests-registry)))
(debug:print-info 8 *default-log-port* "waitons: " waitons)
;; check for hed in waitons => this would be circular, remove it and issue an
;; error
(if (or (member hed waitons)
(member hed waitors))
@@ -483,11 +493,11 @@
(debug:print-error 0 *default-log-port* "test " hed " has listed itself as a waiton or waitor, please correct this!")
(set! waitons (filter (lambda (x)(not (equal? x hed))) waitons))
(set! waitors (filter (lambda (x)(not (equal? x hed))) waitors))))
;; (items (items:get-items-from-config config)))
- (if (not (hash-table-ref/default test-records hed #f))
+ (if (not (hash-table-ref/default test-records hed #f)) ;; waiton-tconfig below will be #f until that test is visted here at least once
(hash-table-set! test-records
hed (vector hed ;; 0
config ;; 1
waitons ;; 2
(config-lookup config "requirements" "priority") ;; priority 3
@@ -494,20 +504,29 @@
(tests:get-items config) ;; expand the [items] and or [itemstable] into explict items
#f ;; itemsdat 5
#f ;; spare - used for item-path
waitors ;;
)))
- (for-each
+ ;; update waitors-upon here
+ (for-each
+ (lambda (waiton)
+ (let* ((current-waitors-upon (hash-table-ref/default waitors-upon waiton '())))
+ (if (not (member hed current-waitors-upon))
+ (hash-table-set! waitors-upon waiton (cons hed current-waitors-upon)))))
+ (if (list? waitons) waitons '()))
+
+ (for-each
(lambda (waiton)
(if (and waiton (not (member waiton test-names)))
- (let* ((waiton-record (hash-table-ref/default test-records waiton #f))
+ (let* ((waitors-in-testpatt (runs:make-sure-all-waitors-upon-are-in-testpatts testpatts (hash-table-ref/default waitors-upon waiton '())))
+ (waiton-record (hash-table-ref/default test-records waiton #f))
(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 - chained-waiton goes awry by now.
(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?
;;
@@ -516,19 +535,23 @@
;; 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
+ (if waiton-tconfig ;; BB: waiter should be in test-patts as well as the waiton have a 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 *default-log-port* "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
+ (if waitors-in-testpatt
+ (begin
+ (debug:print-info 0 *default-log-port* "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 *default-log-port* "Waitor(s) not yet on testpatt for " waiton ", setting up to re-process it")
+ (set! tal (append (cons waiton tal)(list hed)))))
+ (begin
(debug:print-info 0 *default-log-port* "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 *default-log-port* "No testconfig info yet for " waiton ", setting up to re-process it")
@@ -647,11 +670,10 @@
;; 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)
res