102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
(set! db (open-db))
(if (not (args:get-arg "-server"))
(server:client-setup db))
;; (set! *cache-on* #t)
(set-megatest-env-vars db run-id) ;; these may be needed by the launching process
(change-directory work-area)
;; Open up the test specific database
(set! tdb (open-test-db work-area))
(debug:print 0 "Finalizing both tdb and db!!!")
(sqlite3:finalize! tdb)
(sqlite3:finalize! db)))
(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)
(save-environment-as-files "megatest")
(test-set-meta-info db tdb run-id test-name itemdat)
(test-set-status! db 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
|
<
<
|
<
|
|
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
(set! db (open-db))
(if (not (args:get-arg "-server"))
(server:client-setup db))
;; (set! *cache-on* #t)
(set-megatest-env-vars db run-id) ;; these may be needed by the launching process
(change-directory work-area)
(on-exit (lambda ()
(debug:print 0 "Finalizing db!!!")
(sqlite3:finalize! db)))
(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)
(save-environment-as-files "megatest")
(test-set-meta-info db test-id run-id test-name itemdat)
(test-set-status! db 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
|
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
|
;; (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? (test-get-kill-request db run-id test-name itemdat))
(test-set-meta-info db tdb run-id test-name itemdat minutes: 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
|
|
|
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
|
;; (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? (test-get-kill-request db run-id test-name itemdat))
(test-set-meta-info db test-id run-id test-name itemdat minutes: 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
|