Megatest

Check-in [63e558983a]
Login
Overview
Comment:Added -include support for archive get
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-broken
Files: files | file ages | folders
SHA1: 63e558983a2101551ea0fa140888a5e6fd4322ae
User & Date: mrwellan on 2020-05-04 22:51:26
Other Links: branch diff | manifest | tags
Context
2020-05-05
11:29
Added -inlcude support to save and get for archive check-in: b487e8f3c5 user: mrwellan tags: v1.65-broken
2020-05-04
22:51
Added -include support for archive get check-in: 63e558983a user: mrwellan tags: v1.65-broken
16:06
Fixed the ../megatest ../dashboard issue. check-in: 19f75192e2 user: mrwellan tags: v1.65-broken
Changes

Modified archive.scm from [80337cecee] to [228240a5c7].

341
342
343
344
345
346
347
348




349
350
351
352
353
354
355
341
342
343
344
345
346
347

348
349
350
351
352
353
354
355
356
357
358







-
+
+
+
+







	      (mutex-unlock! rp-mutex)
	      (new-test-physical-path  (conc best-disk "/" test-partial-path))
	      (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)))
	      (archive-internal-path   (conc (common:get-testsuite-name) "-" run-id "/latest/" test-partial-path))
	      (include-paths           (args:get-arg "-include"))
	      (exclude-pattern         (args:get-arg "-exclude-rx"))
	      (exclude-file            (args:get-arg "-exclude-rx-from")))
	 
	 ;; some sanity checks, move an existing path out of the way - iif it is not a toplevel with children
	 ;;
	 (if (and (not toplevel/children)  ;; special handling needed for toplevel with children
		  prev-test-physical-path
		  (common: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))
438
439
440
441
442
443
444
445




446
447
448
449
450
451
452







453
454
455
456
457
458
459
441
442
443
444
445
446
447

448
449
450
451
452
453
454
455



456
457
458
459
460
461
462
463
464
465
466
467
468
469







-
+
+
+
+




-
-
-
+
+
+
+
+
+
+







		   (test-path         (conc linktree "/" test-partial-path))
		   (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)
						#f))
		   (archive-internal-path   (conc (common:get-testsuite-name) "-" run-id
						  "/latest/" test-partial-path)))
						  "/latest/" test-partial-path))
		   (include-paths           (args:get-arg "-include"))
		   (exclude-pattern         (args:get-arg "-exclude-rx"))
		   (exclude-file            (args:get-arg "-exclude-rx-from")))
	      
	      (if (and archive-path ;; no point in proceeding if there is no actual archive
		       (not toplevel/children))
		  (begin
		    (let* ((bup-restore-params  (list "-d" archive-path "restore" "-C" (or destpath "data")
						      ;; " " ;; What is the empty string for?
						      archive-internal-path)))
		    (let* ((bup-restore-params (append (list "-d" archive-path "restore" "-C" (or destpath "data"))
						       ;; " " ;; What is the empty string for?
						       (if include-paths
							   (map (lambda (p)
								  (conc archive-internal-path "/" p))
								(string-split include-paths ","))
							   (list archive-internal-path)))))
		      (debug:print-info 0 *default-log-port* "Restoring archived data to " (or destpath "data")
					" from archive in " archive-path " ... " archive-internal-path)
		      (run-n-wait bup-exe params: bup-restore-params print-cmd: #t)))
		  (let ((new-rem-tests (filter (lambda (tdat)
						 (or (not (eq? (db:test-get-id tdat) test-id))
						     (not (eq? (db:test-get-run_id tdat) run-id))))
					       rem-tests) ))

Modified megatest.scm from [6278a546f3] to [7ac73079e8].

343
344
345
346
347
348
349


350
351
352



353
354
355
356
357
358
359
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364







+
+



+
+
+







			"-setvars"
			"-set-state-status"

                        ;; move runs stuff here
                        "-remove-keep"           
			"-set-run-status"
			"-age"

			;; archive 
			"-archive"
			"-actions"
			"-precmd"
			"-include"
			"-exclude-rx"
			"-exclude-rx-from"
			
			"-debug" ;; for *verbosity* > 2
			"-create-test"
			"-override-timeout"
			"-test-files"  ;; -test-paths is for listing all
			"-load"        ;; load and exectute a scheme file
			"-section"