363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
|
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
|
-
-
+
+
+
+
+
+
+
+
|
(if (not (null? required-tests))
(debug:print-info 1 "Adding " 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")))
(if (> (length (hash-table-keys test-records)) 0)
(begin
(runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests (any->number reglen) all-tests-registry)
(let ((th1 (make-thread (lambda ()
(runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests (any->number reglen) all-tests-registry))
"runs:run-tests-queue"))
(th2 (make-thread (lambda ()
(rmt:find-and-mark-incomplete-all-runs)))))
(thread-start! th1)
(thread-start! th2)
(thread-join! th1)
;; if run-count > 0 call, set -preclean and -rerun STUCK/DEAD
(if (> run-count 0)
(begin
(if (not (hash-table-ref/default flags "-preclean" #f))
(hash-table-set! flags "-preclean" #t))
(if (not (hash-table-ref/default flags "-rerun" #f))
(hash-table-set! flags "-rerun" "STUCK/DEAD,n/a,ZERO_ITEMS"))
|
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
|
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
|
+
+
-
+
+
|
(tal (cdr sorted-test-names))
(reg '()) ;; registered, put these at the head of tal
(reruns '()))
(if (not (null? reruns))(debug:print-info 4 "reruns=" reruns))
;; Here we mark any old defunct tests as incomplete. Do this every fifteen minutes
;; moving this to a parallel thread and just run it once.
;;
(if (> (current-seconds)(+ last-time-incomplete 900))
(begin
(set! last-time-incomplete (current-seconds))
(rmt:find-and-mark-incomplete-all-runs)))
;; (rmt:find-and-mark-incomplete-all-runs)
))
;; (print "Top of loop, hed=" hed ", tal=" tal " ,reruns=" reruns)
(let* ((test-record (hash-table-ref test-records hed))
(test-name (tests:testqueue-get-testname test-record))
(tconfig (tests:testqueue-get-testconfig test-record))
(jobgroup (config-lookup tconfig "test_meta" "jobgroup"))
(testmode (let ((m (config-lookup tconfig "requirements" "mode")))
|