320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
|
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
|
+
-
+
|
;; 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 "RUNNING" area-dat)
(rmt:roll-up-pass-fail-counts run-id test-name item-path "RUNNING" area-dat)
(rmt:roll-up-pass-fail-counts run-id test-name item-path #f "RUNNING" area-dat)
;; (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 area-dat)
(let loop ((i 0))
|
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
|
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
|
+
-
+
|
(begin
(debug:print-info 0 "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 "LAUNCHED" area-dat)
(rmt:roll-up-pass-fail-counts run-id test-name item-path "LAUNCHED" area-dat)
(rmt:roll-up-pass-fail-counts run-id test-name item-path #f "LAUNCHED" area-dat)
(set! diskpath (get-best-disk configdat))
(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 "Using work area " work-area))
(begin
|