Megatest

Diff
Login

Differences From Artifact [bf539ba83a]:

To Artifact [340ad26128]:


229
230
231
232
233
234
235
236


237
238



239


240
241
242
243
244
245
246
229
230
231
232
233
234
235

236
237
238
239
240
241
242

243
244
245
246
247
248
249
250
251







-
+
+


+
+
+
-
+
+







	      (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 
	 ;; some sanity checks, move an existing path out of the way
	 ;;
	 (if (and prev-test-physical-path
		  (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))
		   (dirn (pathname-file      prev-test-physical-path))
		   (newn (conc base "/." dirn)))
	     (debug:print 0 "ERROR: the old directory " prev-test-physical-path ", still exists! This should not be."))
	       (debug:print 0 "ERROR: the old directory " prev-test-physical-path ", still exists! Moving it to " newn)
	       (file-move prev-test-physical-path newn)))

	 (if archive-path ;; no point in proceeding if there is no actual archive
	     (begin
	       ;; CREATE WORK AREA
	       ;; test-src-path == #f     ==> don't copy in data from tests directory
	       ;; itemdat       == string ==> use directly
	       (create-work-area run-id run-name keyvals test-id #f best-disk test-name item-path) ;; #!key (remtries 2))
257
258
259
260
261
262
263
264


265
266
267
262
263
264
265
266
267
268

269
270
271
272
273







-
+
+



					       (db:test-get-rundir new-test-dat)
					       (begin
						 (debug:print 0 "ERROR: unable to get data for run-id=" run-id ", test-id=" test-id)
						 (exit 1))))
		      ;; new-test-path won't work - must use best-disk instead? Nope, new-test-path but tack on /..
		      (bup-restore-params  (list "-d" archive-path "restore" "-C" (conc new-test-path "/..") archive-internal-path)))
		 (debug:print-info 0 "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path)
		 (run-n-wait bup-exe params: bup-restore-params print-cmd: #f)))
		 (run-n-wait bup-exe params: bup-restore-params print-cmd: #f)
		 (mt:test-set-state-status-by-id run-id test-id "COMPLETED" #f #f)))
	     (debug:print 0 "ERROR: No archive path in the record for run-id=" run-id " test-id=" test-id))))
     (filter vector? tests))))