442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
|
(begin
(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))
(hash-table-set! test-records
hed (vector hed ;; 0
config ;; 1
waitons ;; 2
(config-lookup config "requirements" "priority") ;; priority 3
(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
(lambda (waiton)
(if (and waiton (not (member waiton test-names)))
|
|
|
|
|
|
|
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
|
(begin
(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))
(hash-table-set! test-records ;; BB: we are doing a manual make-tests:testqueue
hed (vector hed ;; 0 ;; testname
config ;; 1
waitons ;; 2
(config-lookup config "requirements" "priority") ;; priority 3
(tests:get-items config) ;; 4 ;; expand the [items] and or [itemstable] into explict items
#f ;; itemsdat 5
#f ;; spare - used for item-path
waitors ;;
)))
(for-each
(lambda (waiton)
(if (and waiton (not (member waiton test-names)))
|
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
|
((not (null? tal))
(debug:print-info 4 *default-log-port* "I'm pretty sure I shouldn't get here."))
((not (null? reg)) ;; could we get here with leftovers?
(debug:print-info 0 *default-log-port* "Have leftovers!")
(loop (car reg)(cdr reg) '() reruns))
(else
(debug:print-info 4 *default-log-port* "Exiting loop with...\n hed=" hed "\n tal=" tal "\n reruns=" reruns))
)))
|
>
|
|
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
|
((not (null? tal))
(debug:print-info 4 *default-log-port* "I'm pretty sure I shouldn't get here."))
((not (null? reg)) ;; could we get here with leftovers?
(debug:print-info 0 *default-log-port* "Have leftovers!")
(loop (car reg)(cdr reg) '() reruns))
(else
(debug:print-info 4 *default-log-port* "Exiting loop with...\n hed=" hed "\n tal=" tal "\n reruns=" reruns))
))) ;; end loop on sorted test names
;; now *if* -run-wait we wait for all tests to be done
;; Now wait for any RUNNING tests to complete (if in run-wait mode)
(thread-sleep! 5) ;; I think there is a race condition here. Let states/statuses settle
(let wait-loop ((num-running (rmt:get-count-tests-running-for-run-id run-id))
(prev-num-running 0))
;; (debug:print-info 13 *default-log-port* "num-running=" num-running ", prev-num-running=" prev-num-running)
(if (and (or (args:get-arg "-run-wait")
|