91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
(change-directory top-path)
(if (not (setup-for-run))
(begin
(debug:print 0 "Failed to setup, exiting")
;; (sqlite3:finalize! db)
;; (sqlite3:finalize! tdb)
(exit 1)))
(change-directory *toppath*)
(open-run-close set-megatest-env-vars #f run-id) ;; these may be needed by the launching process
(change-directory work-area)
(open-run-close set-run-config-vars #f run-id)
;; environment overrides are done *before* the remaining critical envars.
(alist->env-vars env-ovrd)
|
>
>
>
|
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
(change-directory top-path)
(if (not (setup-for-run))
(begin
(debug:print 0 "Failed to setup, exiting")
;; (sqlite3:finalize! db)
;; (sqlite3:finalize! tdb)
(exit 1)))
;; Can setup as client for server mode now
(server:client-setup)
(change-directory *toppath*)
(open-run-close set-megatest-env-vars #f run-id) ;; these may be needed by the launching process
(change-directory work-area)
(open-run-close set-run-config-vars #f run-id)
;; environment overrides are done *before* the remaining critical envars.
(alist->env-vars env-ovrd)
|
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
|
(inexact->exact
(round
(-
(current-seconds)
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")))
;; (rdb:test-update-meta-info db test-id minutes cpuload diskfree tmpfree)
|
<
<
<
<
<
<
<
<
<
|
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
|
(inexact->exact
(round
(-
(current-seconds)
start-seconds)))))
(kill-tries 0))
(let loop ((minutes (calc-minutes)))
(begin
(set! kill-job? (open-run-close test-get-kill-request #f test-id)) ;; run-id test-name itemdat))
(open-run-close test-set-meta-info #f test-id run-id test-name itemdat minutes)
(if kill-job?
(begin
(mutex-lock! m)
(let* ((pid (vector-ref exit-info 0)))
(if (number? pid)
(begin
(debug:print 0 "WARNING: Request received to kill job (attempt # " kill-tries ")")
|
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
|
(th1 (make-thread monitorjob))
(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))
;; Old logic:
;; (if (vector-ref exit-info 1) ;; look at the exit-status, #t means it at least ran
;; (if (and (not kill-job?)
;; (eq? (vector-ref exit-info 2) 0)) ;; we can now use rollup-status instead
;; "PASS"
;; "FAIL")
;; "FAIL")
;; New logic based on rollup-status
|
<
<
<
<
<
<
<
<
<
<
<
|
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
|
(th1 (make-thread monitorjob))
(th2 (make-thread runit)))
(set! job-thread th2)
(thread-start! th1)
(thread-start! th2)
(thread-join! th2)
(mutex-lock! m)
(let* ((item-path (item-list->path itemdat))
(testinfo (open-run-close db:get-test-info-by-id #f test-id))) ;; )) ;; 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)
(open-run-close tests:test-set-status! #f test-id
(if kill-job? "KILLED" "COMPLETED")
(cond
((not (vector-ref exit-info 1)) "FAIL") ;; job failed to run
((eq? rollup-status 0)
;; if the current status is AUTO the defer to the calculated value (i.e. leave this AUTO)
(if (equal? (db:test-get-status testinfo) "AUTO") "AUTO" "PASS"))
((eq? rollup-status 1) "FAIL")
((eq? rollup-status 2)
|