Overview
Comment: | Made dumpmode for megatest.config default to ini. Added calling of the preclean spec when archiving |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65 |
Files: | files | file ages | folders |
SHA1: |
50a6d511213fbb79c2105e6478e0a0c8 |
User & Date: | matt on 2018-05-29 00:12:54 |
Other Links: | branch diff | manifest | tags |
Context
2018-05-29
| ||
09:08 | Minor formating cleanup check-in: c4eadcfc06 user: mrwellan tags: v1.65 | |
00:12 | Made dumpmode for megatest.config default to ini. Added calling of the preclean spec when archiving check-in: 50a6d51121 user: matt tags: v1.65 | |
2018-05-28
| ||
22:55 | Added directory clean up routines for use in archive. check-in: 55ad7b5c03 user: matt tags: v1.65 | |
Changes
Modified archive.scm from [2b8c7ad3e5] to [618f9a591e].
︙ | ︙ | |||
145 146 147 148 149 150 151 | (linktree (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree"))) (archiver (let ((s (configf:lookup *configdat* "archive" "archiver"))) (if s (string->symbol s) 'bup))) (archiver-cmd (case archiver ((tar) "tar cfj ARCHIVE_NAME.tar.bz2 ") ((7z) " 7z u -t7z -m0=lzma -mx=9 -mfb=64 -md=32m -ms=on ARCHIVE_NAME.7z ") (else #f))) | | > > > > | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 | (linktree (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree"))) (archiver (let ((s (configf:lookup *configdat* "archive" "archiver"))) (if s (string->symbol s) 'bup))) (archiver-cmd (case archiver ((tar) "tar cfj ARCHIVE_NAME.tar.bz2 ") ((7z) " 7z u -t7z -m0=lzma -mx=9 -mfb=64 -md=32m -ms=on ARCHIVE_NAME.7z ") (else #f))) (print-prefix "Running: ") ;; change to #f to turn off printing (preclean-spec (configf:get-section *configdat* "archive-preclean"))) ;; (tests:match patt testname itempath) ;; from the test info bin the path to the test by stem ;; (for-each (lambda (test-dat) (let* ((item-path (db:test-get-item-path test-dat)) (test-name (db:test-get-testname test-dat)) (test-id (db:test-get-id test-dat)) |
︙ | ︙ | |||
190 191 192 193 194 195 196 197 198 199 200 201 202 203 | min-space " MB space to the [archive-disks] section of megatest.config") (debug:print 0 *default-log-port* " use [archive] minspace to specify minimum available space") (debug:print 0 *default-log-port* " disks: " (string-intersperse (map cadr (archive:get-archive-disks)) "\n ")) (exit 1)) (debug:print-info 0 *default-log-port* "Using path " archive-dir " for archiving test " test-path)) (cond (toplevel/children (debug:print 0 *default-log-port* "WARNING: cannot archive " test-name " with id " test-id " as it is a toplevel test with children")) ((not (common:file-exists? test-path)) (debug:print 0 *default-log-port* "WARNING: Cannot archive " test-name "/" item-path " as path " test-path " does not exist")) | > > > > > > > > > > > > > > > > | 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 | min-space " MB space to the [archive-disks] section of megatest.config") (debug:print 0 *default-log-port* " use [archive] minspace to specify minimum available space") (debug:print 0 *default-log-port* " disks: " (string-intersperse (map cadr (archive:get-archive-disks)) "\n ")) (exit 1)) (debug:print-info 0 *default-log-port* "Using path " archive-dir " for archiving test " test-path)) ;; preclean the test directory per the spec if provided (if (not (null? preclean-spec)) ;; we've been asked to preclean before archiving (let loop ((spec (car preclean-spec)) (tail (cdr preclean-spec))) (if (> (length spec) 1) (let ((testspec (car spec)) (rules (cadr spec))) (if (tests:match testspec test-name item-path) (begin (debug:print 0 *default-log-port* "INFO: cleanup requested for " test-physical-path) (common:dir-clean-up test-physical-path rules remove-empty: #t)) (if (not (null? tail)) (loop (car tail)(cdr tail))))) (begin (debug:print 0 *default-log-port* "ERROR: bad spec line in [archive-preclean] section. \"" spec "\"") (if (not (null? tail))(loop (car tail)(cdr tail))))))) (cond (toplevel/children (debug:print 0 *default-log-port* "WARNING: cannot archive " test-name " with id " test-id " as it is a toplevel test with children")) ((not (common:file-exists? test-path)) (debug:print 0 *default-log-port* "WARNING: Cannot archive " test-name "/" item-path " as path " test-path " does not exist")) |
︙ | ︙ |
Modified megatest.scm from [64480090d8] to [d7d2b320b7].
︙ | ︙ | |||
997 998 999 1000 1001 1002 1003 | ((and (args:get-arg "-section") (args:get-arg "-var")) (let ((val (configf:lookup data (args:get-arg "-section")(args:get-arg "-var")))) (if val (print val)))) ;; print just a section if only -section | | | > | | 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 | ((and (args:get-arg "-section") (args:get-arg "-var")) (let ((val (configf:lookup data (args:get-arg "-section")(args:get-arg "-var")))) (if val (print val)))) ;; print just a section if only -section ((equal? (args:get-arg "-dumpmode") "sexp") (pp (hash-table->alist data))) ((equal? (args:get-arg "-dumpmode") "json") (json-write data)) ((or (not (args:get-arg "-dumpmode")) (string=? (args:get-arg "-dumpmode") "ini")) (configf:config->ini data)) (else (debug:print-error 0 *default-log-port* "-dumpmode of " (args:get-arg "-dumpmode") " not recognised"))) (set! *didsomething* #t) (pop-directory) (set! *time-to-exit* #t))) |
︙ | ︙ |