Overview
| Comment: | Improved feedback when archiving is blocked for some reason |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
e05e127ba0486036ed61d6e89c4d58c1 |
| User & Date: | mrwellan on 2015-07-14 15:21:32 |
| Other Links: | branch diff | manifest | tags |
Context
|
2015-07-15
| ||
| 09:28 | Change archiving ERROR's to WARNING's check-in: 106d429710 user: mrwellan tags: v1.60 | |
|
2015-07-14
| ||
| 15:21 | Improved feedback when archiving is blocked for some reason check-in: e05e127ba0 user: mrwellan tags: v1.60 | |
| 14:02 | Bumped version to 1.6021 check-in: bb8b165e5f user: mrwellan tags: v1.60, v1.6021 | |
Changes
Modified archive.scm from [1e200bee3b] to [8c7a48b5ff].
| ︙ | ︙ | |||
143 144 145 146 147 148 149 | (test-base (if (and partial-path-index test-physical-path ) (substring test-physical-path 0 partial-path-index) #f))) | > | > | < > | | | | | | | | | | | | 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 |
(test-base (if (and partial-path-index
test-physical-path )
(substring test-physical-path
0
partial-path-index)
#f)))
(cond
(toplevel/children
(debug:print 0 "ERROR: cannot archive " test-name " with id " test-id " as it is a toplevel test with children"))
((not (file-exists? test-path))
(debug:print 0 "ERROR: Cannot archive " test-name "/" item-path " as path " test-path " does not exist"))
(else
(debug:print 0
"From test-dat=" test-dat " derived the following:\n"
"test-partial-path = " test-partial-path "\n"
"test-path = " test-path "\n"
"test-physical-path = " test-physical-path "\n"
"partial-path-index = " partial-path-index "\n"
"test-base = " test-base)
(hash-table-set! disk-groups test-base (cons test-physical-path (hash-table-ref/default disk-groups test-base '())))
(hash-table-set! test-groups test-base (cons test-dat (hash-table-ref/default test-groups test-base '())))
test-path))))
tests)
;; for each disk-group
(for-each
(lambda (disk-group)
(debug:print 0 "Processing disk-group " disk-group)
(let* ((test-paths (hash-table-ref disk-groups disk-group))
;; ((string-intersperse (map cadr (rmt:get-key-val-pairs 1)) "-")
|
| ︙ | ︙ |