218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
-
+
|
(if (file-exists? runconfigf)
(open-run-close setup-env-defaults db runconfigf run-id *already-seen-runconfig-info* "pre-launch-env-vars")
(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))
;; look up all tests matching the comma separated list of globs in
;; test-patts (using % as wildcard)
(set! test-names (tests:get-valid-tests *toppath* test-names))
(set! test-names (append (tests:get-valid-tests *toppath* test-patts) test-names))
(set! test-names (delete-duplicates test-names))
(debug:print-info 0 "test names " test-names)
;; on the first pass or call to run-tests set FAILS to NOT_STARTED if
;; -keepgoing is specified
(if (eq? *passnum* 0)
|
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
|
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
|
-
+
+
|
(define (runs:run-tests-queue run-id runname test-records keyvallst flags test-patts)
;; At this point the list of parent tests is expanded
;; NB// Should expand items here and then insert into the run queue.
(debug:print 5 "test-records: " test-records ", keyvallst: " keyvallst " flags: " (hash-table->alist flags))
(let ((sorted-test-names (tests:sort-by-priority-and-waiton test-records))
(test-registery (make-hash-table))
(num-retries 0)
(max-retries (config-lookup *configdat* "setup" "maxretries")))
(max-retries (config-lookup *configdat* "setup" "maxretries"))
(dotfilep (if (args:get-arg "-dotfile")(open-output-file (args:get-arg "-dotfile")) #f)))
(set! max-retries (if (and max-retries (string->number max-retries))(string->number max-retries) 100))
(if (not (null? sorted-test-names))
(let loop ((hed (car sorted-test-names))
(tal (cdr sorted-test-names))
(reruns '()))
(if (not (null? reruns))(debug:print-info 4 "reruns=" reruns))
;; (print "Top of loop, hed=" hed ", tal=" tal " ,reruns=" reruns)
|
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
|
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
|
+
+
+
+
+
+
-
+
|
(thread-sleep! (+ 2 *global-delta*))
;; could have done hed tal here but doing car/cdr of newtal to rotate tests
(loop (car newtal)(cdr newtal) reruns))
((and have-resources
(or (null? prereqs-not-met)
(and (eq? testmode 'toplevel)
(null? non-completed))))
(if dotfilep
(with-output-to-port (lambda ()
(for-each (lambda (w)
(print " " w " -> " test-name ";"))
waitons)
(print " " test-name ";")))
(run:test run-id runname keyvallst test-record flags #f)
(run:test run-id runname keyvallst test-record flags #f))
(thread-sleep! *global-delta*)
(if (not (null? tal))
(loop (car tal)(cdr tal) reruns)))
(else ;; must be we have unmet prerequisites
(debug:print 4 "FAILS: " fails)
;; If one or more of the prereqs-not-met are FAIL then we can issue
;; a message and drop hed from the items to be processed.
|