136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
(num-running-in-jobgroup (cdb:remote-run db:get-count-tests-running-in-jobgroup #f jobgroup))
(max-concurrent-jobs (let ((mcj (config-lookup *configdat* "setup" "max_concurrent_jobs")))
(if (and mcj (string->number mcj))
(string->number mcj)
1)))
(job-group-limit (config-lookup *configdat* "jobgroups" jobgroup)))
(if (and (> (+ num-running num-running-in-jobgroup) 0)
(< *runs:can-run-more-tests-delay* 2))
(begin
(set! *runs:can-run-more-tests-delay* (+ *runs:can-run-more-tests-delay* 0.01))
(debug:print-info 14 "can-run-more-tests-delay: " *runs:can-run-more-tests-delay*)))
(if (not (eq? *last-num-running-tests* num-running))
(begin
(debug:print 2 "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
(set! *last-num-running-tests* num-running)))
(if (not (eq? 0 *globalexitstatus*))
(list #f num-running num-running-in-jobgroup max-concurrent-jobs job-group-limit)
|
|
|
|
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
(num-running-in-jobgroup (cdb:remote-run db:get-count-tests-running-in-jobgroup #f jobgroup))
(max-concurrent-jobs (let ((mcj (config-lookup *configdat* "setup" "max_concurrent_jobs")))
(if (and mcj (string->number mcj))
(string->number mcj)
1)))
(job-group-limit (config-lookup *configdat* "jobgroups" jobgroup)))
(if (and (> (+ num-running num-running-in-jobgroup) 0)
(< *runs:can-run-more-tests-delay* 1))
(begin
(set! *runs:can-run-more-tests-delay* (+ *runs:can-run-more-tests-delay* 0.009))
(debug:print-info 14 "can-run-more-tests-delay: " *runs:can-run-more-tests-delay*)))
(if (not (eq? *last-num-running-tests* num-running))
(begin
(debug:print 2 "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
(set! *last-num-running-tests* num-running)))
(if (not (eq? 0 *globalexitstatus*))
(list #f num-running num-running-in-jobgroup max-concurrent-jobs job-group-limit)
|
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
|
(setenv "MT_TEST_NAME" test-name) ;;
(setenv "MT_RUNNAME" runname)
(set-megatest-env-vars run-id) ;; these may be needed by the launching process
(let ((items-list (items:get-items-from-config tconfig)))
(if (list? items-list)
(begin
(tests:testqueue-set-items! test-record items-list)
(thread-sleep! *global-delta*)
(loop hed tal reruns))
(begin
(debug:print 0 "ERROR: The proc from reading the setup did not yield a list - please report this")
(exit 1))))))
((null? fails)
(debug:print-info 4 "fails is null, moving on in the queue but keeping " hed " for now")
;; only increment num-retries when there are no tests runing
|
|
|
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
|
(setenv "MT_TEST_NAME" test-name) ;;
(setenv "MT_RUNNAME" runname)
(set-megatest-env-vars run-id) ;; these may be needed by the launching process
(let ((items-list (items:get-items-from-config tconfig)))
(if (list? items-list)
(begin
(tests:testqueue-set-items! test-record items-list)
;; (thread-sleep! *global-delta*)
(loop hed tal reruns))
(begin
(debug:print 0 "ERROR: The proc from reading the setup did not yield a list - please report this")
(exit 1))))))
((null? fails)
(debug:print-info 4 "fails is null, moving on in the queue but keeping " hed " for now")
;; only increment num-retries when there are no tests runing
|
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
|
(loop (car newtal)(cdr newtal) reruns))) ;; an issue with prereqs not yet met?
((and (not (null? fails))(eq? testmode 'normal))
(debug:print-info 1 "test " hed " (mode=" testmode ") has failed prerequisite(s); "
(string-intersperse (map (lambda (t)(conc (db:test-get-testname t) ":" (db:test-get-state t)"/"(db:test-get-status t))) fails) ", ")
", removing it from to-do list")
(if (not (null? tal))
(begin
(thread-sleep! *global-delta*)
(loop (car tal)(cdr tal)(cons hed reruns)))))
(else
(debug:print 8 "ERROR: No handler for this condition.")
(thread-sleep! (+ 1 *global-delta*))
(loop (car newtal)(cdr newtal) reruns)))) ;; END OF IF CAN RUN MORE
;; if can't run more just loop with next possible test
(begin
(debug:print-info 4 "processing the case with a lambda for items or 'have-procedure. Moving through the queue without dropping " hed)
(thread-sleep! (+ 2 *global-delta*))
(loop (car newtal)(cdr newtal) reruns))))) ;; END OF (or (procedure? items)(eq? items 'have-procedure))
;; this case should not happen, added to help catch any bugs
((and (list? items) itemdat)
(debug:print 0 "ERROR: Should not have a list of items in a test and the itemspath set - please report this")
(exit 1))
((not (null? reruns))
(let* ((newlst (tests:filter-non-runnable run-id tal test-records)) ;; i.e. not FAIL, WAIVED, INCOMPLETE, PASS, KILLED,
(junked (lset-difference equal? tal newlst)))
(debug:print-info 4 "full drop through, if reruns is less than 100 we will force retry them, reruns=" reruns ", tal=" tal)
(if (< num-retries max-retries)
(set! newlst (append reruns newlst)))
(set! num-retries (+ num-retries 1))
(thread-sleep! (+ 1 *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)))))
((not (null? tal))
(debug:print-info 4 "I'm pretty sure I shouldn't get here."))
(else
(debug:print-info 4 "Exiting loop with...\n hed=" hed "\n tal=" tal "\n reruns=" reruns))
|
|
|
|
|
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
|
(loop (car newtal)(cdr newtal) reruns))) ;; an issue with prereqs not yet met?
((and (not (null? fails))(eq? testmode 'normal))
(debug:print-info 1 "test " hed " (mode=" testmode ") has failed prerequisite(s); "
(string-intersperse (map (lambda (t)(conc (db:test-get-testname t) ":" (db:test-get-state t)"/"(db:test-get-status t))) fails) ", ")
", removing it from to-do list")
(if (not (null? tal))
(begin
;; (thread-sleep! *global-delta*)
(loop (car tal)(cdr tal)(cons hed reruns)))))
(else
(debug:print 8 "ERROR: No handler for this condition.")
(thread-sleep! (+ 1 *global-delta*))
(loop (car newtal)(cdr newtal) reruns)))) ;; END OF IF CAN RUN MORE
;; if can't run more just loop with next possible test
(begin
(debug:print-info 4 "processing the case with a lambda for items or 'have-procedure. Moving through the queue without dropping " hed)
;; (thread-sleep! (+ 2 *global-delta*))
(loop (car newtal)(cdr newtal) reruns))))) ;; END OF (or (procedure? items)(eq? items 'have-procedure))
;; this case should not happen, added to help catch any bugs
((and (list? items) itemdat)
(debug:print 0 "ERROR: Should not have a list of items in a test and the itemspath set - please report this")
(exit 1))
((not (null? reruns))
(let* ((newlst (tests:filter-non-runnable run-id tal test-records)) ;; i.e. not FAIL, WAIVED, INCOMPLETE, PASS, KILLED,
(junked (lset-difference equal? tal newlst)))
(debug:print-info 4 "full drop through, if reruns is less than 100 we will force retry them, reruns=" reruns ", tal=" tal)
(if (< num-retries max-retries)
(set! newlst (append reruns newlst)))
(set! num-retries (+ num-retries 1))
;; (thread-sleep! (+ 1 *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)))))
((not (null? tal))
(debug:print-info 4 "I'm pretty sure I shouldn't get here."))
(else
(debug:print-info 4 "Exiting loop with...\n hed=" hed "\n tal=" tal "\n reruns=" reruns))
|