288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
|
(define (runs:run-tests-queue run-id runname test-records keyvallst flags)
;; 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))
(item-patts (hash-table-ref/default flags "-itempatt" #f))
(test-registery (make-hash-table))
(num-retries 0))
(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 4 "INFO: reruns=" reruns))
(let* ((test-record (hash-table-ref test-records hed))
(test-name (tests:testqueue-get-testname test-record))
|
|
>
>
|
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
|
(define (runs:run-tests-queue run-id runname test-records keyvallst flags)
;; 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))
(item-patts (hash-table-ref/default flags "-itempatt" #f))
(test-registery (make-hash-table))
(num-retries 0)
(max-retries (config-lookup *configdat* "setup" "maxretries")))
(if (and max-retries (string->number max-retries))(set! 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 4 "INFO: reruns=" reruns))
(let* ((test-record (hash-table-ref test-records hed))
(test-name (tests:testqueue-get-testname test-record))
|
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
|
(if (not *runremote*)(exit)) ;;
#f) ;; return a #f as a hint that we are done
;; Here we need to check that all the tests remaining to be run are eligible to run
;; and are not blocked by failed
(let* ((newlst (open-run-close tests:filter-non-runnable #f run-id tal test-records)) ;; i.e. not FAIL, WAIVED, INCOMPLETE, PASS, KILLED,
(junked (lset-difference equal? tal newlst)))
(debug:print 4 "INFO: full drop through, if reruns is less than 100 we will force retry them: " reruns)
(if (< num-retries 100)
(set! newlst (append reruns newlst)))
(set! num-retries (+ num-retries 1))
(thread-sleep! *global-delta*)
(if (not (null? newlst))
;; since reruns have been tacked on to newlst create new reruns from junked
(loop (car newlst)(cdr newlst)(delete-duplicates junked)))))))))
|
|
|
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
|
(if (not *runremote*)(exit)) ;;
#f) ;; return a #f as a hint that we are done
;; Here we need to check that all the tests remaining to be run are eligible to run
;; and are not blocked by failed
(let* ((newlst (open-run-close tests:filter-non-runnable #f run-id tal test-records)) ;; i.e. not FAIL, WAIVED, INCOMPLETE, PASS, KILLED,
(junked (lset-difference equal? tal newlst)))
(debug:print 4 "INFO: full drop through, if reruns is less than 100 we will force retry them: " reruns)
(if (< num-retries max-retries)
(set! newlst (append reruns newlst)))
(set! num-retries (+ num-retries 1))
(thread-sleep! *global-delta*)
(if (not (null? newlst))
;; since reruns have been tacked on to newlst create new reruns from junked
(loop (car newlst)(cdr newlst)(delete-duplicates junked)))))))))
|