239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
;; (tests:test-set-status! test-id "RUNNING" "n/a" #f #f)
;; Since we should have a clean slate at this time there is no need to do
;; any of the other stuff that tests:test-set-status! does. Let's just
;; force RUNNING/n/a
;; (thread-sleep! 0.3)
;; (tests:test-force-state-status! run-id test-id "RUNNING" "n/a")
(rmt:roll-up-pass-fail-counts run-id test-name item-path #f "RUNNING")
;; (thread-sleep! 0.3) ;; NFS slowness has caused grief here
;; if there is a runscript do it first
(if fullrunscript
(let ((pid (process-run fullrunscript)))
(rmt:test-set-top-process-pid run-id test-id pid)
(let loop ((i 0))
|
|
|
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
;; (tests:test-set-status! test-id "RUNNING" "n/a" #f #f)
;; Since we should have a clean slate at this time there is no need to do
;; any of the other stuff that tests:test-set-status! does. Let's just
;; force RUNNING/n/a
;; (thread-sleep! 0.3)
;; (tests:test-force-state-status! run-id test-id "RUNNING" "n/a")
(rmt:roll-up-pass-fail-counts run-id test-name item-path #f "RUNNING" #f)
;; (thread-sleep! 0.3) ;; NFS slowness has caused grief here
;; if there is a runscript do it first
(if fullrunscript
(let ((pid (process-run fullrunscript)))
(rmt:test-set-top-process-pid run-id test-id pid)
(let loop ((i 0))
|
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
|
(not (member (db:test-get-rundir testinfo)(list "n/a" "/tmp/badname")))) ;; n/a is a placeholder and thus not a read dir
(begin
(debug:print-info 0 *default-log-port* "attempting to preclean directory " (db:test-get-rundir testinfo) " for test " test-name "/" item-path)
(runs:remove-test-directory testinfo 'remove-data-only))) ;; remove data only, do not perturb the record
;; prevent overlapping actions - set to LAUNCHED as early as possible
;;
(tests:test-set-status! run-id test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED"))
(rmt:roll-up-pass-fail-counts run-id test-name item-path #f "LAUNCHED")
(set! diskpath (get-best-disk *configdat* tconfig))
(if diskpath
(let ((dat (create-work-area run-id run-info keyvals test-id test-path diskpath test-name itemdat)))
(set! work-area (car dat))
(set! toptest-work-area (cadr dat))
(debug:print-info 2 *default-log-port* "Using work area " work-area))
(begin
|
>
|
|
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
|
(not (member (db:test-get-rundir testinfo)(list "n/a" "/tmp/badname")))) ;; n/a is a placeholder and thus not a read dir
(begin
(debug:print-info 0 *default-log-port* "attempting to preclean directory " (db:test-get-rundir testinfo) " for test " test-name "/" item-path)
(runs:remove-test-directory testinfo 'remove-data-only))) ;; remove data only, do not perturb the record
;; prevent overlapping actions - set to LAUNCHED as early as possible
;;
;; the following call handles waiver propogation. cannot yet condense into roll-up-pass-fail
(tests:test-set-status! run-id test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED"))
(rmt:roll-up-pass-fail-counts run-id test-name item-path #f "LAUNCHED" #f)
(set! diskpath (get-best-disk *configdat* tconfig))
(if diskpath
(let ((dat (create-work-area run-id run-info keyvals test-id test-path diskpath test-name itemdat)))
(set! work-area (car dat))
(set! toptest-work-area (cadr dat))
(debug:print-info 2 *default-log-port* "Using work area " work-area))
(begin
|