| ︙ | | | ︙ | |
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
(itemdat (assoc/default 'itemdat cmdinfo))
(env-ovrd (assoc/default 'env-ovrd cmdinfo))
(set-vars (assoc/default 'set-vars cmdinfo)) ;; pre-overrides from -setvar
(runname (assoc/default 'runname cmdinfo))
(megatest (assoc/default 'megatest cmdinfo))
(mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo))
(fullrunscript (if runscript (conc testpath "/" runscript) #f))
(db #f))
(debug:print 2 "Exectuing " test-name " on " (get-host-name))
(change-directory testpath)
;; apply pre-overrides before other variables. The pre-override vars must not
;; clobbers things from the official sources such as megatest.config and runconfigs.config
(if (string? set-vars)
(let ((varpairs (string-split set-vars ",")))
|
|
>
|
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
(itemdat (assoc/default 'itemdat cmdinfo))
(env-ovrd (assoc/default 'env-ovrd cmdinfo))
(set-vars (assoc/default 'set-vars cmdinfo)) ;; pre-overrides from -setvar
(runname (assoc/default 'runname cmdinfo))
(megatest (assoc/default 'megatest cmdinfo))
(mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo))
(fullrunscript (if runscript (conc testpath "/" runscript) #f))
(db #f)
(rollup-status 0))
(debug:print 2 "Exectuing " test-name " on " (get-host-name))
(change-directory testpath)
;; apply pre-overrides before other variables. The pre-override vars must not
;; clobbers things from the official sources such as megatest.config and runconfigs.config
(if (string? set-vars)
(let ((varpairs (string-split set-vars ",")))
|
| ︙ | | | ︙ | |
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
(let loop ((i 0))
(let-values
(((pid-val exit-status exit-code) (process-wait pid #t)))
(mutex-lock! m)
(vector-set! exit-info 0 pid)
(vector-set! exit-info 1 exit-status)
(vector-set! exit-info 2 exit-code)
(mutex-unlock! m)
(if (eq? pid-val 0)
(begin
(thread-sleep! 2)
(loop (+ i 1)))
)))))
;; then, if runscript ran ok (or did not get called)
|
>
|
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
(let loop ((i 0))
(let-values
(((pid-val exit-status exit-code) (process-wait pid #t)))
(mutex-lock! m)
(vector-set! exit-info 0 pid)
(vector-set! exit-info 1 exit-status)
(vector-set! exit-info 2 exit-code)
(set! rollup-status exit-code)
(mutex-unlock! m)
(if (eq? pid-val 0)
(begin
(thread-sleep! 2)
(loop (+ i 1)))
)))))
;; then, if runscript ran ok (or did not get called)
|
| ︙ | | | ︙ | |
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
;; check exit-info (vector-ref exit-info 1)
(if (vector-ref exit-info 1)
(let* ((stepname (car ezstep)) ;; do stuff to run the step
(stepinfo (cadr ezstep))
(stepparts (string-match (regexp "^(\\{([^\\}]*)\\}\\s*|)(.*)$") stepinfo))
(stepparms (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each
(stepcmd (list-ref stepparts 3))
(script "#!/bin/bash\n") ;; yep, we depend on bin/bash FIXME!!!
(logpro-used #f))
;; NB// can safely assume we are in test-area directory
(debug:print 4 "ezsteps:\n stepname: " stepname " stepinfo: " stepinfo " stepparts: " stepparts
" stepparms: " stepparms " stepcmd: " stepcmd)
(if (file-exists? (conc stepname ".logpro"))(set! logpro-used #t))
;; first source the previous environment
(if (and prevstep (file-exists? prevstep))
(set! script (conc script "source .ezsteps/" prevstep ".sh")))
;; call the command using mt_ezstep
(set! script (conc script "mt_ezstep " stepname " " stepcmd "\n"))
(debug:print 4 "script: " script)
(teststep-set-status! db run-id test-name stepname "start" "-" itemdat #f #f)
;; now launch
(let ((pid (process-run script)))
(let processloop ((i 0))
|
|
>
|
|
|
|
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
;; check exit-info (vector-ref exit-info 1)
(if (vector-ref exit-info 1)
(let* ((stepname (car ezstep)) ;; do stuff to run the step
(stepinfo (cadr ezstep))
(stepparts (string-match (regexp "^(\\{([^\\}]*)\\}\\s*|)(.*)$") stepinfo))
(stepparms (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each
(stepcmd (list-ref stepparts 3))
(script "") ; "#!/bin/bash\n") ;; yep, we depend on bin/bash FIXME!!!
(logpro-used #f))
;; NB// can safely assume we are in test-area directory
(debug:print 4 "ezsteps:\n stepname: " stepname " stepinfo: " stepinfo " stepparts: " stepparts
" stepparms: " stepparms " stepcmd: " stepcmd)
(if (file-exists? (conc stepname ".logpro"))(set! logpro-used #t))
;; first source the previous environment
(let ((prev-env (conc ".ezsteps/" prevstep (if (string-search (regexp "csh") (get-environment-variable "SHELL")) ".csh" ".sh"))))
(if (and prevstep (file-exists? prev-env))
(set! script (conc script "source " prev-env))))
;; call the command using mt_ezstep
(set! script (conc script ";mt_ezstep " stepname " " stepcmd))
(debug:print 4 "script: " script)
(teststep-set-status! db run-id test-name stepname "start" "-" itemdat #f #f)
;; now launch
(let ((pid (process-run script)))
(let processloop ((i 0))
|
| ︙ | | | ︙ | |
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
|
(begin
(thread-sleep! 2)
(processloop (+ i 1))))
))
(teststep-set-status! db run-id test-name stepname "end" (vector-ref exit-info 2) itemdat #f (if logpro-used (conc stepname ".html") ""))
(if logpro-used
(test-set-log! db run-id test-name itemdat (conc stepname ".html")))
(debug:print 4 "Exit value received: " (vector-ref exit-info 2) " logpro-used: " logpro-used)
(cond
;; WARN from logpro
((and (eq? (vector-ref exit-info 2) 2) logpro-used)
(test-set-status! db run-id test-name "COMPLETE" "WARN" itemdat "Logpro warning found" #f))
((eq? (vector-ref exit-info 2) 0)
(test-set-status! db run-id test-name "COMPLETE" "PASS" itemdat #f #f))
(else
(test-set-status! db run-id test-name "COMPLETE" "FAIL" itemdat (conc "Failed at step " stepname) #f)))
)
(if (and (steprun-good? logpro-used (vector-ref exit-info 2))
(not (null? tal)))
(loop (car tal) (cdr tal) stepname)))
(debug:print 4 "WARNING: a prior step failed, stopping at " ezstep))))))))
(monitorjob (lambda ()
(let* ((start-seconds (current-seconds))
(calc-minutes (lambda ()
|
|
|
<
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
|
|
>
|
<
|
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
|
(begin
(thread-sleep! 2)
(processloop (+ i 1))))
))
(teststep-set-status! db run-id test-name stepname "end" (vector-ref exit-info 2) itemdat #f (if logpro-used (conc stepname ".html") ""))
(if logpro-used
(test-set-log! db run-id test-name itemdat (conc stepname ".html")))
;; set the test final status
(let* ((this-step-status (cond
((and (eq? (vector-ref exit-info 2) 2) logpro-used) 'warn)
((eq? (vector-ref exit-info 2) 0) 'pass)
(else 'fail)))
(overall-status (cond
((eq? rollup-status 2) 'warn)
((eq? rollup-status 0) 'pass)
(else 'fail)))
(next-status (cond
((eq? overall-status 'pass) this-step-status)
((eq? overall-status 'warn)
(if (eq? this-step-status 'fail) 'fail 'warn))
(else 'fail))))
(debug:print 4 "Exit value received: " (vector-ref exit-info 2) " logpro-used: " logpro-used
" this-step-status: " this-step-status " overall-status: " overall-status
" next-status: " next-status " rollup-status: " rollup-status)
(case next-status
((warn)
(set! rollup-status 2)
(test-set-status! db run-id test-name "COMPLETED" "WARN" itemdat
(if (eq? this-step-status 'warn) "Logpro warning found" #f)
#f))
((pass)
(test-set-status! db run-id test-name "COMPLETED" "PASS" itemdat #f #f))
(else ;; 'fail
(set! rollup-status 1) ;; force fail
(test-set-status! db run-id test-name "COMPLETED" "FAIL" itemdat (conc "Failed at step " stepname) #f)))))
(if (and (steprun-good? logpro-used (vector-ref exit-info 2))
(not (null? tal)))
(loop (car tal) (cdr tal) stepname)))
(debug:print 4 "WARNING: a prior step failed, stopping at " ezstep))))))))
(monitorjob (lambda ()
(let* ((start-seconds (current-seconds))
(calc-minutes (lambda ()
|
| ︙ | | | ︙ | |
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
|
(thread-join! th2)
(mutex-lock! m)
(set! db (open-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")
(test-set-status! db run-id test-name
(if kill-job? "KILLED" "COMPLETED")
(if (vector-ref exit-info 1) ;; look at the exit-status
(if (and (not kill-job?)
(eq? (vector-ref exit-info 2) 0))
"PASS"
"FAIL")
"FAIL") itemdat (args:get-arg "-m") #f)))
;; for automated creation of the rollup html file this is a good place...
(if (not (equal? item-path ""))
(tests:summarize-items db run-id test-name #f)) ;; don't force - just update if no
)
(mutex-unlock! m)
;; (exec-results (cmd-run->list fullrunscript)) ;; (list ">" (conc test-name "-run.log"))))
;; (success exec-results)) ;; (eq? (cadr exec-results) 0)))
|
|
>
|
|
|
|
>
|
>
>
>
>
>
>
>
|
|
287
288
289
290
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
|
(thread-join! th2)
(mutex-lock! m)
(set! db (open-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")
;; 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
(cond
((not (vector-ref exit-info 1)) "FAIL") ;; job failed to run
((eq? rollup-status 0) "PASS")
((eq? rollup-status 1) "FAIL")
((eq? rollup-status 2) "WARN")
(else "FAIL"))
itemdat (args:get-arg "-m") #f)))
;; for automated creation of the rollup html file this is a good place...
(if (not (equal? item-path ""))
(tests:summarize-items db run-id test-name #f)) ;; don't force - just update if no
)
(mutex-unlock! m)
;; (exec-results (cmd-run->list fullrunscript)) ;; (list ">" (conc test-name "-run.log"))))
;; (success exec-results)) ;; (eq? (cadr exec-results) 0)))
|
| ︙ | | | ︙ | |