229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
|
(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
(if (and prev-test-physical-path
(file-exists? prev-test-physical-path)) ;; what to do? abort or clean up or link it in?
(debug:print 0 "ERROR: the old directory " prev-test-physical-path ", still exists! This should not be."))
(if archive-path ;; no point in proceeding if there is no actual archive
(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))
|
|
>
>
>
>
|
>
|
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
|
(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
;;
(if (and 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)))
(if archive-path ;; no point in proceeding if there is no actual archive
(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))
|
257
258
259
260
261
262
263
264
265
266
267
|
(db:test-get-rundir new-test-dat)
(begin
(debug:print 0 "ERROR: unable to get data for run-id=" run-id ", test-id=" test-id)
(exit 1))))
;; new-test-path won't work - must use best-disk instead? Nope, new-test-path but tack on /..
(bup-restore-params (list "-d" archive-path "restore" "-C" (conc new-test-path "/..") archive-internal-path)))
(debug:print-info 0 "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path)
(run-n-wait bup-exe params: bup-restore-params print-cmd: #f)))
(debug:print 0 "ERROR: No archive path in the record for run-id=" run-id " test-id=" test-id))))
(filter vector? tests))))
|
|
>
|
262
263
264
265
266
267
268
269
270
271
272
273
|
(db:test-get-rundir new-test-dat)
(begin
(debug:print 0 "ERROR: unable to get data for run-id=" run-id ", test-id=" test-id)
(exit 1))))
;; new-test-path won't work - must use best-disk instead? Nope, new-test-path but tack on /..
(bup-restore-params (list "-d" archive-path "restore" "-C" (conc new-test-path "/..") archive-internal-path)))
(debug:print-info 0 "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path)
(run-n-wait bup-exe params: bup-restore-params print-cmd: #f)
(mt:test-set-state-status-by-id run-id test-id "COMPLETED" #f #f)))
(debug:print 0 "ERROR: No archive path in the record for run-id=" run-id " test-id=" test-id))))
(filter vector? tests))))
|