158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
-
-
-
+
+
+
|
(if (> (- currtime lasttime) waitval)
(begin
(hash-table-set! *runs:denoise* key currtime)
#t)
#f)))
(define (runs:can-run-more-tests run-id jobgroup max-concurrent-jobs)
(thread-sleep! (cond
((> *runs:can-run-more-tests-count* 20) 2);; obviously haven't had any work to do for a while
(else 0)))
;;(thread-sleep! (cond
;; ((> *runs:can-run-more-tests-count* 20) 2);; obviously haven't had any work to do for a while
;; (else 0)))
(let* ((num-running (rmt:get-count-tests-running run-id))
(num-running-in-jobgroup (rmt:get-count-tests-running-in-jobgroup run-id jobgroup))
(job-group-limit (let ((jobg-count (config-lookup *configdat* "jobgroups" jobgroup)))
(if (string? jobg-count)
(string->number jobg-count)
jobg-count))))
(if (> (+ num-running num-running-in-jobgroup) 0)
|
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
|
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
|
-
+
|
(if (> (current-seconds)(+ last-time-incomplete 900))
(begin
(debug:print-info 0 "Marking stuck tests as INCOMPLETE while waiting for run " run-id ". Running as pid " (current-process-id) " on " (get-host-name))
(set! last-time-incomplete (current-seconds))
(rmt:find-and-mark-incomplete run-id #f)))
(if (not (eq? num-running prev-num-running))
(debug:print-info 0 "run-wait specified, waiting on " num-running " tests in RUNNING, REMOTEHOSTSTART or LAUNCHED state at " (time->string (seconds->local-time (current-seconds)))))
(thread-sleep! 15)
(thread-sleep! 5)
;; (wait-loop (rmt:get-count-tests-running-for-run-id run-id) num-running))))
(wait-loop (rmt:get-count-tests-running-for-run-id run-id) num-running))))
;; LET* ((test-record
;; we get here on "drop through". All done!
(debug:print-info 1 "All tests launched")))
(define (runs:calc-fails prereqs-not-met)
|