| ︙ | | |
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
-
-
+
+
|
;; (run-n-wait fullrunscript)))
;; (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")
;; (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))
|
| ︙ | | |
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
|
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
|
-
+
|
(lnkbase (conc linktree "/" target "/" runname))
(lnkpath (conc lnkbase "/" testname))
(lnkpathf (conc lnkpath (if not-iterated "" "/") item-path))
(lnktarget (conc lnkpath "/" item-path)))
;; Update the rundir path in the test record for all, rundir=physical, shortdir=logical
;; rundir shortdir
(rmt:general-call 'test-set-rundir-shortdir run-id lnkpathf test-path testname item-path)
(rmt:general-call 'test-set-rundir-shortdir run-id lnkpathf test-path testname item-path run-id)
(debug:print 2 *default-log-port* "INFO:\n lnkbase=" lnkbase "\n lnkpath=" lnkpath "\n toptest-path=" toptest-path "\n test-path=" test-path)
(if (not (file-exists? linktree))
(begin
(debug:print 0 *default-log-port* "WARNING: linktree did not exist! Creating it now at " linktree)
(create-directory linktree #t))) ;; (system (conc "mkdir -p " linktree))))
;; create the directory for the tests dir links, this is needed no matter what...
|
| ︙ | | |
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
|
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
|
-
+
|
(hash-table-set! *toptest-paths* testname curr-test-path)
;; NB// Was this for the test or for the parent in an iterated test?
(rmt:general-call 'test-set-rundir-shortdir run-id lnkpath
(if (file-exists? lnkpath)
;; (resolve-pathname lnkpath)
(common:nice-path lnkpath)
lnkpath)
testname "")
testname "" run-id)
;; (rmt:general-call 'test-set-rundir run-id lnkpath testname "") ;; toptest-path)
(if (or (not curr-test-path)
(not (directory-exists? toptest-path)))
(begin
(debug:print-info 2 *default-log-port* "Creating " toptest-path " and link " lnkpath)
(handle-exceptions
exn
|
| ︙ | | |
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
|
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")
(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
|
| ︙ | | |