res))))
;;======================================================================
;; M I S C M A N A G E M E N T I T E M S
;;======================================================================
;; A routine to map itempaths using a itemmap
;; patha and pathb must be strings or this will fail
;;
(define (db:compare-itempaths patha pathb itemmap)
(debug:print-info 6 "ITEMMAP is " itemmap)
(if itemmap
(let ((pathb-mapped (db:multi-pattern-apply pathb itemmap)))
(debug:print-info 6 "ITEMMAP is " itemmap ", path: " pathb ", mapped path: " pathb-mapped)
(equal? patha pathb-mapped))
(equal? patha pathb)))
(define (db:compare-itempaths patha pathb itemmaps)
(debug:print-info 6 "ITEMMAPS: " itemmaps)
(let* ((testname-a (car (string-split patha "/")))
(itemmap (tests:lookup-itemmap itemmaps testname-a)))
(if itemmap
(let ((pathb-mapped (db:multi-pattern-apply pathb itemmap)))
(debug:print-info 6 "ITEMMAP is " itemmap ", path: " pathb ", mapped path: " pathb-mapped)
(equal? patha pathb-mapped))
(equal? patha pathb))))
;; (let* ((mapparts (string-split itemmap));; (pattern (car mapparts));; (replacement (if (> (length mapparts) 1) (cadr mapparts) "")));; (if replacement;; (equal? (string-substitute pattern replacement patha);; (string-substitute pattern replacement pathb));; (equal? (string-substitute pattern "" patha);; (string-substitute pattern "" pathb))))
;; A routine to convert test/itempath using a itemmap
;; NOTE: to process only an itempath (i.e. no prepended testname)
;; just call db:multi-pattern-apply
;;
(define (db:convert-test-itempath path-in itemmap)
(debug:print-info 6 "ITEMMAP is " itemmap)
;; if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met
;;
;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED)
;; mode 'toplevel means that tests must be COMPLETED only
;; mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]]
;;
;; (define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode)
(define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode itemmap) ;; #!key (mode '(normal))(itemmap #f))
(define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode itemmaps) ;; #!key (mode '(normal))(itemmap #f))
(if (or (not waitons)
(null? waitons))
'()
(let* ((unmet-pre-reqs '())
(result '()))
(for-each
(lambda (waitontest-name)
(let* ((state (db:test-get-state test))
(status (db:test-get-status test))
(item-path (db:test-get-item-path test))
(is-completed (equal? state "COMPLETED"))
(is-running (equal? state "RUNNING"))
(is-killed (equal? state "KILLED"))
(is-ok (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))
(same-itempath (db:compare-itempaths item-path ref-item-path itemmap))) ;; (equal? ref-item-path item-path)))
(same-itempath (db:compare-itempaths item-path ref-item-path itemmaps))) ;; (equal? ref-item-path 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))))))
(set! parent-waiton-met #t))
;; Special case for toplevel and KILLED
((and (equal? item-path "") ;; this is the parent test
is-killed
(member 'toplevel mode))
(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))))
((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 "")
(or is-completed is-running));; this is the parent, set it to run if completed or running
(set! parent-waiton-met #t)))
</div></div>
</div>
<div class="sect3">
<h4 id="_complex_mappings">Complex mappings</h4>
<div class="paragraph"><p>Complex mappings can be handled with the [itemmap] section</p></div>
<div class="imageblock">
<div class="content">
<img src="itemmap.png" alt="itemmap.png">
<img src="complex-itemmap.png" alt="complex-itemmap.png">
</div>
</div>
<div class="paragraph"><p>Example:</p></div>
<div class="olist arabic"><ol class="arabic">
<li>
<p>
Request to run D/1/res
</p>
</li>
<li>
<p>
Megatest calculates all posible items for Test C and filters down to: C/1/aa
</p>
</li>
<li>
<p>
Full list to be run is now: D/1/res, C/1/aa
</p>
</li>
<li>
<p>
Megatest calculates all posible items for Test A and filters down to: A/aa/1
</p>
</li>
<li>
<p>
Full list to be run is now: D/1/res, C/1/aa, A/aa/1
</p>
</li>
</ol></div>
<div class="listingblock">
<div class="title">Testconfig for Test C</div>
<div class="content monospaced">
<pre>[requirements]
waiton A B
[itemmap]
A (\d+)/aa aa/\1
B (\d+)/bb bb/\1</pre>
</div></div>
<div class="listingblock">
<div class="title">Testconfig for Test D</div>
<div class="content monospaced">
<pre>[requirements]
waiton C
itemmap (\d+)/res \1/aa</pre>
</div></div>
<div class="listingblock">
<div class="title">Testconfig for Test E</div>
<div class="content monospaced">
<pre>[requirements]
waiton C
itemmap (\d+)/res \1/bb</pre>
</div></div>
</div>
<div class="sect3">
<h4 id="_dynamic_flow_dependency_tree">Dynamic Flow Dependency Tree</h4>
<div class="listingblock">
<div class="title">Autogeneration waiton list for dynamic flow dependency trees</div>
<div class="content monospaced">
<pre>[requirements]
# With a toplevel test you may wish to generate your list
# of tests to run dynamically
#
-------------------
Complex mappings
^^^^^^^^^^^^^^^^
Complex mappings can be handled with the [itemmap] section
image::itemmap.png[]
// image::itemmap.png[]
image::complex-itemmap.png[]
Example:
.Complex mapping from
. Request to run D/1/res
. Megatest calculates all posible items for Test C and filters down to: C/1/aa
. Full list to be run is now: D/1/res, C/1/aa
. Megatest calculates all posible items for Test A and filters down to: A/aa/1
. Full list to be run is now: D/1/res, C/1/aa, A/aa/1
.Testconfig for Test C
----------------------
[requirements]
waiton A B
[itemmap]
A (\d+)/aa aa/\1
B (\d+)/bb bb/\1
----------------------
.Testconfig for Test D
----------------------
[requirements]
waiton C
itemmap (\d+)/res \1/aa
----------------------
.Testconfig for Test E
----------------------
[requirements]
waiton C
itemmap (\d+)/res \1/bb
----------------------
Dynamic Flow Dependency Tree
^^^^^^^^^^^^^^^^^^^^^^^^^^^^
.Autogeneration waiton list for dynamic flow dependency trees
-------------------
[requirements]
# With a toplevel test you may wish to generate your list
# of tests to run dynamically
#
# waiton #{shell get-valid-tests-to-run.sh}
(lambda (waiton)
(if (and waiton (not (member waiton test-names)))
(let* ((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))))
(itemmap (configf:lookup config "requirements" "itemmap"))
(new-test-patts (tests:extend-test-patts test-patts hed waiton itemmap)))
(itemmaps (tests:get-itemmaps config));; (configf:lookup config "requirements" "itemmap"))
(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")
;; 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
;; items is #f then the test is ok to be handed off to launch (but not before)
;;
((not items)
(debug:print-info 4 "OUTER COND: (not items)")
(if (and (not (tests:match test-patts (tests:testqueue-get-testname test-record) item-path required: required-tests))
(not (null? tal)))
(loop (car tal)(cdr tal) reg reruns))
(let ((loop-list (runs:process-expanded-tests hed tal reg reruns reglen regfull test-record runname test-name item-path jobgroup max-concurrent-jobs run-id waitons item-path testmode test-patts required-tests test-registry registry-mutex flags keyvals run-info newtal all-tests-registry itemmap)))
(let ((loop-list (runs:process-expanded-tests hed tal reg reruns reglen regfull test-record runname test-name item-path jobgroup max-concurrent-jobs run-id waitons item-path testmode test-patts required-tests test-registry registry-mutex flags keyvals run-info newtal all-tests-registry itemmaps)))
(if loop-list (apply loop loop-list))))
;; items processed into a list but not came in as a list been processed
;;
((and (list? items) ;; thus we know our items are already calculated
(not itemdat)) ;; and not yet expanded into the list of things to be done
(debug:print-info 4 "OUTER COND: (and (list? items)(not itemdat))")
;; if items is a proc then need to run items:get-items-from-config, get the list and loop
;; - but only do that if resources exist to kick off the job
;; EXPAND ITEMS
((or (procedure? items)(eq? items 'have-procedure))
(let ((can-run-more (runs:can-run-more-tests 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 itemmap)))
(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)))
(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))))
;; this case should not happen, added to help catch any bugs
((and (list? items) itemdat)