Megatest

Check-in [50a6d51121]
Login
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: 50a6d511213fbb79c2105e6478e0a0c89ae32dff
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
152





153
154
155
156
157
158
159
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
	 (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))
189
190
191
192
193
194
195
196
197


















198
199
200
201
202
203
204
193
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
224







-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	       (debug:print 0 *default-log-port* "FATAL: No archive disks found. Please add disks with at least "
			    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

	 ;; 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"))
	  (else

Modified megatest.scm from [64480090d8] to [d7d2b320b7].

997
998
999
1000
1001
1002
1003
1004

1005
1006

1007

1008

1009
1010
1011
1012
1013
1014
1015
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

       ((not (args:get-arg "-dumpmode"))
       ((equal? (args:get-arg "-dumpmode") "sexp")
	(pp (hash-table->alist data)))
       ((string=? (args:get-arg "-dumpmode") "json")
       ((equal? (args:get-arg "-dumpmode") "json")
	(json-write data))
       ((or (not (args:get-arg "-dumpmode"))
       ((string=? (args:get-arg "-dumpmode") "ini")
	    (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)))