332
333
334
335
336
337
338
339
340
341
342
343
344
345
|
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
|
+
|
;; test-records is a hash table testname:item_path => vector < testname testconfig waitons priority items-info ... >
(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))
(registery-mutex (make-mutex))
(num-retries 0)
(max-retries (config-lookup *configdat* "setup" "maxretries")))
(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 '()))
|
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
|
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
|
+
+
-
-
+
+
+
+
+
-
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
|
((not (tests:match test-patts (tests:testqueue-get-testname test-record) item-path)) ;; This test/itempath is not to be run
;; else the run is stuck, temporarily or permanently
;; but should check if it is due to lack of resources vs. prerequisites
(debug:print-info 1 "Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " test-patts)
;; (thread-sleep! *global-delta*)
(if (not (null? tal))
(loop (car tal)(cdr tal) reruns)))
;; Registery has been started for this test but has not yet completed
;; this should be rare, the case where there are only a couple of tests and the db is slow
( ;; (and
(not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f))
;; delay a short while and continue
((eq? (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f) 'start)
(thread-sleep! 0.01)
(loop (car newtal)(cdr newtal) reruns))
((not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f))
;; (and max-concurrent-jobs (> (- max-concurrent-jobs num-running) 5)))
(db:tests-register-test run-id test-name item-path)
(hash-table-set! test-registery (runs:make-full-test-name test-name item-path) #t)
;; (thread-sleep! *global-delta*)
(runs:shrink-can-run-more-tests-delay)
(cdb:tests-register-test *runremote* run-id test-name item-path)
(mutex-lock! registery-mutex)
(hash-table-set! test-registery (runs:make-full-test-name test-name item-path) 'done)
(mutex-unlock! registery-mutex))
(conc test-name "/" item-path))))
(thread-start! th))
(thread-sleep! *global-delta*)
(runs:shrink-can-run-more-tests-delay) ;; DELAY TWEAKER (still needed?)
(loop (car newtal)(cdr newtal) reruns))
;; At this point *all* test registrations must be completed.
((not (null? (filter (lambda (x)(not (eq? 'done x))) (hash-table-values test-registery))))
(debug:print-info 0 "Waiting on test registrations: " (string-intersperse
(filter (lambda (x)
(not (eq? (hash-table-ref/default test-registery x #f) 'done)))
(hash-table-keys test-registery))
", "))
(thread-sleep! 0.1)
(loop hed tal reruns))
((not have-resources) ;; simply try again after waiting a second
(debug:print-info 1 "no resources to run new tests, waiting ...")
;; (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))))
(run:test run-id runname keyvallst test-record flags #f)
(runs:shrink-can-run-more-tests-delay)
(runs:shrink-can-run-more-tests-delay) ;; DELAY TWEAKER (still needed?)
;; (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.
|