341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
|
(mutex-unlock! rp-mutex)
(new-test-physical-path (conc best-disk "/" test-partial-path))
(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 - iif it is not a toplevel with children
;;
(if (and (not toplevel/children) ;; special handling needed for toplevel with children
prev-test-physical-path
(common: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))
|
|
>
>
>
|
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
|
(mutex-unlock! rp-mutex)
(new-test-physical-path (conc best-disk "/" test-partial-path))
(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))
(include-paths (args:get-arg "-include"))
(exclude-pattern (args:get-arg "-exclude-rx"))
(exclude-file (args:get-arg "-exclude-rx-from")))
;; 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
prev-test-physical-path
(common: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))
|
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
|
(test-path (conc linktree "/" test-partial-path))
(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)
#f))
(archive-internal-path (conc (common:get-testsuite-name) "-" run-id
"/latest/" test-partial-path)))
(if (and archive-path ;; no point in proceeding if there is no actual archive
(not toplevel/children))
(begin
(let* ((bup-restore-params (list "-d" archive-path "restore" "-C" (or destpath "data")
;; " " ;; What is the empty string for?
archive-internal-path)))
(debug:print-info 0 *default-log-port* "Restoring archived data to " (or destpath "data")
" from archive in " archive-path " ... " archive-internal-path)
(run-n-wait bup-exe params: bup-restore-params print-cmd: #t)))
(let ((new-rem-tests (filter (lambda (tdat)
(or (not (eq? (db:test-get-id tdat) test-id))
(not (eq? (db:test-get-run_id tdat) run-id))))
rem-tests) ))
|
|
>
>
>
|
|
>
>
>
>
|
|
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
|
(test-path (conc linktree "/" test-partial-path))
(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)
#f))
(archive-internal-path (conc (common:get-testsuite-name) "-" run-id
"/latest/" test-partial-path))
(include-paths (args:get-arg "-include"))
(exclude-pattern (args:get-arg "-exclude-rx"))
(exclude-file (args:get-arg "-exclude-rx-from")))
(if (and archive-path ;; no point in proceeding if there is no actual archive
(not toplevel/children))
(begin
(let* ((bup-restore-params (append (list "-d" archive-path "restore" "-C" (or destpath "data"))
;; " " ;; What is the empty string for?
(if include-paths
(map (lambda (p)
(conc archive-internal-path "/" p))
(string-split include-paths ","))
(list archive-internal-path)))))
(debug:print-info 0 *default-log-port* "Restoring archived data to " (or destpath "data")
" from archive in " archive-path " ... " archive-internal-path)
(run-n-wait bup-exe params: bup-restore-params print-cmd: #t)))
(let ((new-rem-tests (filter (lambda (tdat)
(or (not (eq? (db:test-get-id tdat) test-id))
(not (eq? (db:test-get-run_id tdat) run-id))))
rem-tests) ))
|