365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
|
(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)
(let* ((keep-going #t)
(run-queue-retries 5)
(th1 (make-thread (lambda ()
(handle-exceptions
exn
(begin
(print-call-chain (current-error-port))
(debug:print 0 "ERROR: failure in runs:run-tests-queue thread, error: " ((condition-property-accessor 'exn 'message) exn))
(if (> run-queue-retries 0)
(begin
(set! run-queue-retries (- run-queue-retries 1))
(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 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))))) CAN'T INTERRUPT IT ...
(let ((run-ids (rmt:get-all-run-ids)))
(for-each (lambda (run-id)
(if keep-going
(handle-exceptions
exn
(debug:print 0 "error in calling find-and-mark-incomplete for run-id " run-id)
(rmt:find-and-mark-incomplete run-id #f)))) ;; ovr-deadtime)))
run-ids)))
"runs: mark-incompletes")))
(thread-start! th1)
(thread-start! th2)
(thread-join! th1)
(set! keep-going #f)
(thread-join! th2)
;; 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"))
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
|
(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* ((keep-going #t)
;; (run-queue-retries 5)
;; (th1 (make-thread (lambda ()
;; (handle-exceptions
;; exn
;; (begin
;; (print-call-chain (current-error-port))
;; (debug:print 0 "ERROR: failure in runs:run-tests-queue thread, error: " ((condition-property-accessor 'exn 'message) exn))
;; (if (> run-queue-retries 0)
;; (begin
;; (set! run-queue-retries (- run-queue-retries 1))
;; (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 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))))) CAN'T INTERRUPT IT ...
;; (let ((run-ids (rmt:get-all-run-ids)))
;; (for-each (lambda (run-id)
;; (if keep-going
;; (handle-exceptions
;; exn
;; (debug:print 0 "error in calling find-and-mark-incomplete for run-id " run-id)
;; (rmt:find-and-mark-incomplete run-id #f)))) ;; ovr-deadtime)))
;; run-ids)))
;; "runs: mark-incompletes")))
;; (thread-start! th1)
;; (thread-start! th2)
;; (thread-join! th1)
;; (set! keep-going #f)
;; (thread-join! th2)
;; 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"))
|