229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
-
+
+
-
+
-
+
-
+
+
|
(archive-block-id (db:test-get-archived test-dat))
(archive-block-info (rmt:test-get-archive-block-info archive-block-id))
(archive-path (if (vector? archive-block-info)
(vector-ref archive-block-info 2) ;; look in db.scm for test-get-archive-block-info for the vector record info
#f)) ;; no archive found?
(archive-internal-path (conc (common:get-testsuite-name) "-" run-id "/latest/" test-partial-path)))
;; some sanity checks, move an existing path out of the way
;; some sanity checks, move an existing path out of the way - iif it is not a toplevel with children
;;
(if (and (not toplevel/children) ;; special handling needed for toplevel with children
(if (and prev-test-physical-path
prev-test-physical-path
(file-exists? prev-test-physical-path)) ;; what to do? abort or clean up or link it in?
(let* ((base (pathname-directory prev-test-physical-path))
(dirn (pathname-file prev-test-physical-path))
(newn (conc base "/." dirn)))
(debug:print 0 "ERROR: the old directory " prev-test-physical-path ", still exists! Moving it to " newn)
(file-move prev-test-physical-path newn)))
(rename-file prev-test-physical-path newn)))
(if archive-path ;; no point in proceeding if there is no actual archive
(if (and archive-path ;; no point in proceeding if there is no actual archive
(not toplevel/children))
(begin
;; CREATE WORK AREA
;; test-src-path == #f ==> don't copy in data from tests directory
;; itemdat == string ==> use directly
(create-work-area run-id run-name keyvals test-id #f best-disk test-name item-path) ;; #!key (remtries 2))
;; 1. Get the block id from the test info
|