1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
|
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
|
-
+
|
(run:test run-id run-info keyvals runname test-record flags #f test-registry all-tests-registry runsdat testdat)
(runs:incremental-print-results run-id)
(hash-table-set! test-registry (db:test-make-full-name test-name item-path) 'running)
(runs:shrink-can-run-more-tests-count runsdat) ;; DELAY TWEAKER (still needed?)
;; (thread-sleep! *global-delta*)
(if (or (not (null? tal))(not (null? reg)))
(runs:loop-values tal reg reglen regfull reruns)
(runs:loop-values tal reg reglen regfull reruns) ;; hed should be dropped at this time
#f))
;; must be we have unmet prerequisites
;;
(else
(debug:print 4 *default-log-port* "FAILS: " fails)
;; If one or more of the prereqs-not-met are FAIL then we can issue
|
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
|
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
|
-
+
+
+
|
(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))
;; gonna try a strategy change here.
;;
;; check if can run more tests. if yes, continue, if no, rest until can run more
;;
;; look at the test jobgroup and tot jobs running
;;
;; NOTE: This does NOT actually gate here, only captures the proc to be called later
;;
(if (not (runs:dat-wait-for-jobs-function runsdat))
(runs:dat-wait-for-jobs-function-set!
runsdat
(lambda (testdat-in)
(let* ((jobgroup (runs:testdat-jobgroup testdat-in))
(can-run-more-tests (runs:dat-can-run-more-tests runsdat))
(last-jobs-check-time (runs:dat-last-jobs-check-time runsdat))
|
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
|
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
|
-
-
-
+
+
+
|
(loop (car tal)(cdr tal) reg reruns)))
;; 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))
(debug:print-info 4 *default-log-port* "cond branch - " "rtq-4")
(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 ((can-run-more #f)) ;; (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)))
(if (not can-run-more) #;(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))) ;; itemized test expanded here
(if loop-list
(apply loop loop-list)
(debug:print-info 4 *default-log-port* " -- Can't expand hed="hed)
)
)
;; if can't run more just loop with next possible test
|