83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
(setenv "MT_TEST_RUN_DIR" (conc (getenv "MT_LINKTREE") "/"
(getenv "MT_TARGET") "/"
(getenv "MT_RUNNAME") "/"
(getenv "MT_TEST_NAME")
(if (and itempath
(not (equal? itempath "")))
(conc "/" itempath)
""))))
))
(define (set-item-env-vars itemdat)
(for-each (lambda (item)
(debug:print 2 *default-log-port* "setenv " (car item) " " (cadr item))
(setenv (car item) (cadr item)))
itemdat))
|
|
<
|
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
(setenv "MT_TEST_RUN_DIR" (conc (getenv "MT_LINKTREE") "/"
(getenv "MT_TARGET") "/"
(getenv "MT_RUNNAME") "/"
(getenv "MT_TEST_NAME")
(if (and itempath
(not (equal? itempath "")))
(conc "/" itempath)
""))))))
(define (set-item-env-vars itemdat)
(for-each (lambda (item)
(debug:print 2 *default-log-port* "setenv " (car item) " " (cadr item))
(setenv (car item) (cadr item)))
itemdat))
|
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
(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)
(if (runs:lownoise "waiting on tasks" 60)
(debug:print-info 2 *default-log-port* "waiting for tasks to complete, sleeping briefly ..."))
;; than it than cannot run more jobs
((and max-concurrent-jobs (>= num-running max-concurrent-jobs))
(if (runs:lownoise "mcj msg" 60)
(debug:print 0 *default-log-port* "WARNING: Max running jobs exceeded, current number running: " num-running
", max_concurrent_jobs: " max-concurrent-jobs))
#t)
;; if job-group-limit is set and number of jobs in the group is greater
;; than the limit then cannot run more jobs of this kind
|
<
|
|
|
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
(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)
(if (runs:lownoise "waiting on tasks" 60)(debug:print-info 2 *default-log-port* "waiting for tasks to complete, sleeping briefly ..."))
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)
(set! *runs:can-run-more-tests-count* (+ *runs:can-run-more-tests-count* 1)))
(if (not (eq? *last-num-running-tests* num-running))
(begin
(debug:print 2 *default-log-port* "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)
(let ((can-not-run-more (cond
;; if max-concurrent-jobs is set and the number running is greater
;; than it then cannot run more jobs
((and max-concurrent-jobs (>= num-running max-concurrent-jobs))
(if (runs:lownoise "mcj msg" 60)
(debug:print 0 *default-log-port* "WARNING: Max running jobs exceeded, current number running: " num-running
", max_concurrent_jobs: " max-concurrent-jobs))
#t)
;; if job-group-limit is set and number of jobs in the group is greater
;; than the limit then cannot run more jobs of this kind
|