| ︙ | | |
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
+
+
|
(if (not (setup-for-run))
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
;; now can find our db
(set! db (open-db))
(if (not (args:get-arg "-server"))
(server:client-setup db))
(set-megatest-env-vars db run-id) ;; these may be needed by the launching process
(change-directory work-area)
(set-run-config-vars db run-id)
;; environment overrides are done *before* the remaining critical envars.
(alist->env-vars env-ovrd)
(set-megatest-env-vars db run-id)
(set-item-env-vars itemdat)
|
| ︙ | | |
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
+
+
|
)))))
;; then, if runscript ran ok (or did not get called)
;; do all the ezsteps (if any)
(if ezsteps
(let* ((testconfig (read-config (conc work-area "/testconfig") #f #t environ-patt: "pre-launch-env-vars")) ;; FIXME??? is allow-system ok here?
(ezstepslst (hash-table-ref/default testconfig "ezsteps" '()))
(db (open-db)))
(if (not (args:get-arg "-server"))
(server:client-setup db))
(if (not (file-exists? ".ezsteps"))(create-directory ".ezsteps"))
;; if ezsteps was defined then we are sure to have at least one step but check anyway
(if (not (> (length ezstepslst) 0))
(debug:print 0 "ERROR: ezsteps defined but ezstepslst is zero length")
(let loop ((ezstep (car ezstepslst))
(tal (cdr ezstepslst))
(prevstep #f))
|
| ︙ | | |
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
|
+
+
|
start-seconds)))))
(kill-tries 0))
(let loop ((minutes (calc-minutes)))
(let* ((db (open-db))
(cpuload (get-cpu-load))
(diskfree (get-df (current-directory)))
(tmpfree (get-df "/tmp")))
(if (not (args:get-arg "-server"))
(server:client-setup db))
(if (not cpuload) (begin (debug:print 0 "WARNING: CPULOAD not found.") (set! cpuload "n/a")))
(if (not diskfree) (begin (debug:print 0 "WARNING: DISKFREE not found.") (set! diskfree "n/a")))
(set! kill-job? (test-get-kill-request db run-id test-name itemdat))
(rdb:test-update-meta-info db run-id test-name itemdat minutes cpuload diskfree tmpfree)
(if kill-job?
(begin
(mutex-lock! m)
|
| ︙ | | |
285
286
287
288
289
290
291
292
293
294
295
296
297
298
|
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
|
+
+
|
(th2 (make-thread runit)))
(set! job-thread th2)
(thread-start! th1)
(thread-start! th2)
(thread-join! th2)
(mutex-lock! m)
(set! db (open-db))
(if (not (args:get-arg "-server"))
(server:client-setup db))
(let* ((item-path (item-list->path itemdat))
(testinfo (db:get-test-info db run-id test-name item-path)))
(if (not (equal? (db:test-get-state testinfo) "COMPLETED"))
(begin
(debug:print 2 "Test NOT logged as COMPLETED, (state=" (db:test-get-state testinfo) "), updating result, rollup-status is " rollup-status)
(test-set-status! db run-id test-name
(if kill-job? "KILLED" "COMPLETED")
|
| ︙ | | |