102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
-
+
|
(open-run-close set-run-config-vars #f run-id)
;; environment overrides are done *before* the remaining critical envars.
(alist->env-vars env-ovrd)
(open-run-close set-megatest-env-vars #f run-id)
(set-item-env-vars itemdat)
(save-environment-as-files "megatest")
(open-run-close test-set-meta-info #f test-id run-id test-name itemdat)
(open-run-close test-set-meta-info #f test-id run-id test-name itemdat 0)
(open-run-close test-set-status! #f test-id "REMOTEHOSTSTART" "n/a" (args:get-arg "-m") #f)
(if (args:get-arg "-xterm")
(set! fullrunscript "xterm")
(if (and fullrunscript (not (file-execute-access? fullrunscript)))
(system (conc "chmod ug+x " fullrunscript))))
;; We are about to actually kick off the test
;; so this is a good place to remove the records for
|
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
|
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
|
-
+
|
;; (tmpfree (get-df "/tmp")))
(begin
;; (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? (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: minutes)
(open-run-close test-set-meta-info #f test-id run-id test-name itemdat minutes)
;; (rdb:test-update-meta-info db test-id minutes cpuload diskfree tmpfree)
(if kill-job?
(begin
(mutex-lock! m)
(let* ((pid (vector-ref exit-info 0)))
(if (number? pid)
(begin
|
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
|
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
|
-
+
|
)
(mutex-unlock! m)
;; (exec-results (cmd-run->list fullrunscript)) ;; (list ">" (conc test-name "-run.log"))))
;; (success exec-results)) ;; (eq? (cadr exec-results) 0)))
(debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area "
work-area ":\n====\n exit code " (vector-ref exit-info 2) "\n" "====\n")
;; (sqlite3:finalize! db)
(sqlite3:finalize! tdb)
;; (sqlite3:finalize! tdb)
(if (not (vector-ref exit-info 1))
(exit 4)))))))
;; set up the very basics needed for doing anything here.
(define (setup-for-run)
;; would set values for KEYS in the environment here for better support of env-override but
;; have chicken/egg scenario. need to read megatest.config then read it again. Going to
|