88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
(hash-table-ref blockid-cache key)
(let* ((pscript (configf:lookup *configdat* "archive" "pathscript"))
(pscript-cmd (conc pscript " " testsuite-name " " target " " run-name " " test-name))
(apath (if pscript
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "ERROR: script \"" pscript-cmd "\" failed to run properly.")
(exit 1))
(with-input-from-pipe
pscript-cmd
read-line))
#f)) ;; this is the user-calculated archive path
(adisks (archive:get-archive-disks))
(best-disk (common:get-disk-with-most-free-space adisks dneeded)))
|
|
|
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
(hash-table-ref blockid-cache key)
(let* ((pscript (configf:lookup *configdat* "archive" "pathscript"))
(pscript-cmd (conc pscript " " testsuite-name " " target " " run-name " " test-name))
(apath (if pscript
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "ERROR: script \"" pscript-cmd "\" failed to run properly. exn=" exn)
(exit 1))
(with-input-from-pipe
pscript-cmd
read-line))
#f)) ;; this is the user-calculated archive path
(adisks (archive:get-archive-disks))
(best-disk (common:get-disk-with-most-free-space adisks dneeded)))
|
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
|
(rmt:test-set-archive-block-id run-id test-id archive-id)
(if (member (symbol->string archive-command) '("save-remove"))
(begin
(debug:print-info 0 *default-log-port* "remove testdat")
(runs:remove-test-directory test-dat 'archive-remove)))))
(hash-table-ref test-groups test-base)))))
(hash-table-keys disk-groups))
|
<
|
317
318
319
320
321
322
323
324
325
326
327
328
329
330
|
(rmt:test-set-archive-block-id run-id test-id archive-id)
(if (member (symbol->string archive-command) '("save-remove"))
(begin
(debug:print-info 0 *default-log-port* "remove testdat")
(runs:remove-test-directory test-dat 'archive-remove)))))
(hash-table-ref test-groups test-base)))))
(hash-table-keys disk-groups))
#t))
(define (archive:megatest-db target-patt run-patt)
(let* ((blockid-cache (make-hash-table))
(tsname (common:get-testsuite-name))
(min-space (string->number (or (configf:lookup *configdat* "archive" "minspace") "1000")))
(bup-exe (or (configf:lookup *configdat* "archive" "bup") "bup"))
|