Megatest

Check-in [181a8b6b1c]
Login
Overview
Comment:Cherry pick 5de2f 06451 0364b 07ff7 a374d and full pass on acatqa and ext-tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-cpick01
Files: files | file ages | folders
SHA1: 181a8b6b1c884eb9b2bac4de7a8bc916395659f9
User & Date: mrwellan on 2020-05-31 20:27:01
Other Links: branch diff | manifest | tags
Context
2020-05-31
21:01
Cherrypick ea8c3e 5b7f0 7ff937 18da8b, cpick03, all pass. check-in: f471242dd5 user: mrwellan tags: v1.65-cpick01
20:27
Cherry pick 5de2f 06451 0364b 07ff7 a374d and full pass on acatqa and ext-tests check-in: 181a8b6b1c user: mrwellan tags: v1.65-cpick01
19:49
Cherrypick 0495fb 2a858 from v1.65-broken. check-in: fb39cefbf1 user: mrwellan tags: v1.65-cpick01
Changes

Modified archive.scm from [618f9a591e] to [80337cecee].

384
385
386
387
388
389
390
391













































































		 (debug:print-info 0 *default-log-port* "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path)
		 ;; (mutex-lock! bup-mutex)
		 (run-n-wait bup-exe params: bup-restore-params print-cmd: #f)
		 ;; (mutex-unlock! bup-mutex)
		 (mt:test-set-state-status-by-id run-id test-id "COMPLETED" #f #f)))
	     (debug:print-error 0 *default-log-port* "No archive path in the record for run-id=" run-id " test-id=" test-id))))
     (filter vector? tests))))
	 




















































































|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
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
		 (debug:print-info 0 *default-log-port* "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path)
		 ;; (mutex-lock! bup-mutex)
		 (run-n-wait bup-exe params: bup-restore-params print-cmd: #f)
		 ;; (mutex-unlock! bup-mutex)
		 (mt:test-set-state-status-by-id run-id test-id "COMPLETED" #f #f)))
	     (debug:print-error 0 *default-log-port* "No archive path in the record for run-id=" run-id " test-id=" test-id))))
     (filter vector? tests))))

(define (common:get-youngest-test tests)
  (if (null? tests)
      #f
      (let ((res #f))
	(for-each
	 (lambda (test-dat)
	   (let ((event-time (db:test-get-event_time test-dat)))
	     (if (or (not res)
		     (> event-time (db:test-get-event_time res)))
		 (set! res test-dat))))
	 tests)
	res)))
	   
;; from an archive get a specific path - works ONLY with bup for now
;;
(define (archive:bup-get-data archive-command run-id-in run-name-in tests rp-mutex bup-mutex)
  (if (null? tests)
      (debug:print-info 0 *default-log-port* "get-data called with no matching tests to operate on.")
      
      (let* ((bup-exe      (or (configf:lookup *configdat* "archive" "bup") "bup"))
	     (linktree     (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree")))
	     ;; (test-dat     (common:get-youngest-test tests))
	     (destpath     (args:get-arg "-dest")))
	(cond
	 ((null? tests)
	  (debug:print-error 0 *default-log-port*
			     "No test matching provided target, runname pattern and test pattern found."))
	 ((file-exists? destpath)
	  (debug:print-error 0 *default-log-port*
			     "Destination path alread exists! Please remove it before running get."))
	 (else
	  (let loop ((rem-tests tests))
	    (let* ((test-dat          (common:get-youngest-test rem-tests))
		   (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))
		   (run-id            (db:test-get-run_id    test-dat))
		   (run-name          (rmt:get-run-name-from-id run-id))
		   (keyvals           (rmt:get-key-val-pairs run-id))
		   (target            (string-intersperse (map cadr keyvals) "/"))
		   
		   (toplevel/children (and (db:test-get-is-toplevel test-dat)
					   (> (rmt:test-toplevel-num-items run-id test-name) 0)))
		   (test-partial-path (conc target "/" run-name "/"
					    (db:test-make-full-name test-name item-path)))
		   ;; note the trailing slash to get the dir inspite of it being a link
		   (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)))
	      
	      (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)))
		      (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) ))
		    (debug:print-info 0 *default-log-port*
				      "No archive path in the record for run-id=" run-id
				      " test-id=" test-id ", skipping.")
		    (if (null? new-rem-tests)
			(begin
			  (debug:print-info 0 *default-log-port* "No archives found for " target "/" run-name "...")
			  #f)
			(loop new-rem-tests)))))))))))
  

Modified docs/manual/howto.txt from [b66065dad3] to [5266978039].

66
67
68
69
70
71
72

















73
74
75
76
77
78
79
----------------

Hint: You can browse the archive using bup commands directly.

----------------
bup -d /path/to/bup/archive ftp
----------------


















Submit jobs to Host Types based on Test Name
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

.In megatest.config
------------------------
[host-types]







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
----------------

Hint: You can browse the archive using bup commands directly.

----------------
bup -d /path/to/bup/archive ftp
----------------

Pass Data from Test to Test
~~~~~~~~~~~~~~~~~~~~~~~~~~~

.To save the data call archive save within your test:
----------------
megatest -archive save
----------------

.To retrieve the data call archive get using patterns as needed
----------------
# Put the retrieved data into /tmp
DESTPATH=/tmp/$USER/$MT_TARGET/$MT_RUN_NAME/$MT_TESTNAME/$MT_ITEMPATH/my_data
mkdir -p $DESTPATH
megatest -archive get -runname % -dest $DESTPATH
----------------


Submit jobs to Host Types based on Test Name
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

.In megatest.config
------------------------
[host-types]

Modified docs/manual/megatest_manual.html from [2cca53be9f] to [dd1dac404b].

1450
1451
1452
1453
1454
1455
1456
















1457
1458
1459
1460
1461
1462
1463
<div class="paragraph"><p>Hint: You can browse the archive using bup commands directly.</p></div>
<div class="listingblock">
<div class="content monospaced">
<pre>bup -d /path/to/bup/archive ftp</pre>
</div></div>
</div>
</div>
















</div>
<div class="sect2">
<h3 id="_submit_jobs_to_host_types_based_on_test_name">Submit jobs to Host Types based on Test Name</h3>
<div class="listingblock">
<div class="title">In megatest.config</div>
<div class="content monospaced">
<pre>[host-types]







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
<div class="paragraph"><p>Hint: You can browse the archive using bup commands directly.</p></div>
<div class="listingblock">
<div class="content monospaced">
<pre>bup -d /path/to/bup/archive ftp</pre>
</div></div>
</div>
</div>
</div>
<div class="sect2">
<h3 id="_pass_data_from_test_to_test">Pass Data from Test to Test</h3>
<div class="listingblock">
<div class="title">To save the data call archive save within your test:</div>
<div class="content monospaced">
<pre>megatest -archive save</pre>
</div></div>
<div class="listingblock">
<div class="title">To retrieve the data call archive get using patterns as needed</div>
<div class="content monospaced">
<pre># Put the retrieved data into /tmp
DESTPATH=/tmp/$USER/$MT_TARGET/$MT_RUN_NAME/$MT_TESTNAME/$MT_ITEMPATH/my_data
mkdir -p $DESTPATH
megatest -archive get -runname % -dest $DESTPATH</pre>
</div></div>
</div>
<div class="sect2">
<h3 id="_submit_jobs_to_host_types_based_on_test_name">Submit jobs to Host Types based on Test Name</h3>
<div class="listingblock">
<div class="title">In megatest.config</div>
<div class="content monospaced">
<pre>[host-types]
2364
2365
2366
2367
2368
2369
2370



















2371
2372
2373
2374
2375
2376
2377
</div></div>
<div class="paragraph"><p>To transfer the environment to the next step you can do the following:</p></div>
<div class="listingblock">
<div class="title">Propagate environment to next step</div>
<div class="content monospaced">
<pre>$MT_MEGATEST -env2file .ezsteps/${stepname}</pre>
</div></div>



















<div class="listingblock">
<div class="title">Full example with ezsteps, logpro rules, scripts etc.</div>
<div class="content monospaced">
<pre># You can include a common file
#
[include #{getenv MT_RUN_AREA_HOME}/global-testconfig.inc]








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
</div></div>
<div class="paragraph"><p>To transfer the environment to the next step you can do the following:</p></div>
<div class="listingblock">
<div class="title">Propagate environment to next step</div>
<div class="content monospaced">
<pre>$MT_MEGATEST -env2file .ezsteps/${stepname}</pre>
</div></div>
</div>
<div class="sect2">
<h3 id="_scripts">Scripts</h3>
<div class="listingblock">
<div class="title">Specifying scripts inline (best used for only simple scripts)</div>
<div class="content monospaced">
<pre>[scripts]
loaddb #!/bin/bash
  sqlite3 $1 &lt;&lt;EOF
  .mode tabs
  .import $2 data
  .q
  EOF</pre>
</div></div>
<div class="paragraph"><p>The above snippet results in the creation of an executable script
called "loaddb" in the test directory. NOTE: every line in the script
must be prefixed with the exact same number of spaces. Lines beginning
with a # will not work as expected. Currently you cannot indent
intermediate lines.</p></div>
<div class="listingblock">
<div class="title">Full example with ezsteps, logpro rules, scripts etc.</div>
<div class="content monospaced">
<pre># You can include a common file
#
[include #{getenv MT_RUN_AREA_HOME}/global-testconfig.inc]

3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
</div>
</div>
</div>
<div id="footnotes"><hr></div>
<div id="footer">
<div id="footer-text">
Version 1.0<br>
Last updated 2020-01-02 13:39:49 PST
</div>
</div>
</body>
</html>







|




3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
</div>
</div>
</div>
<div id="footnotes"><hr></div>
<div id="footer">
<div id="footer-text">
Version 1.0<br>
Last updated 2020-02-24 08:51:51 PST
</div>
</div>
</body>
</html>

Modified docs/manual/reference.txt from [41ce966733] to [332bf8caed].

462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
--------------


Complex mapping example
~~~~~~~~~~~~~~~~~~~~~~~



// image::itemmap.png[]
image::complex-itemmap.png[]


We accomplish this by configuring the testconfigs of our tests C D and E as follows:

.Testconfig for Test E has
----------------------
[requirements]
waiton C







<


<







462
463
464
465
466
467
468

469
470

471
472
473
474
475
476
477
--------------


Complex mapping example
~~~~~~~~~~~~~~~~~~~~~~~



// image::itemmap.png[]
image::complex-itemmap.png[]


We accomplish this by configuring the testconfigs of our tests C D and E as follows:

.Testconfig for Test E has
----------------------
[requirements]
waiton C
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
. Test A has no waitons.  All waitons of all tests in full list have been processed.  Full list is finalized.



itemstable
~~~~~~~~~~
An alternative to defining items is the itemstable section.  This lets you define the itempath in a table format rather than specifying components and relying on getting all permutations of those components.





Dynamic Flow Dependency Tree
~~~~~~~~~~~~~~~~~~~~~~~~~~~~

.Autogeneration waiton list for dynamic flow dependency trees
-------------------
[requirements]







<
<
<
<







510
511
512
513
514
515
516




517
518
519
520
521
522
523
. Test A has no waitons.  All waitons of all tests in full list have been processed.  Full list is finalized.



itemstable
~~~~~~~~~~
An alternative to defining items is the itemstable section.  This lets you define the itempath in a table format rather than specifying components and relying on getting all permutations of those components.





Dynamic Flow Dependency Tree
~~~~~~~~~~~~~~~~~~~~~~~~~~~~

.Autogeneration waiton list for dynamic flow dependency trees
-------------------
[requirements]
650
651
652
653
654
655
656




















657
658
659
660
661
662
663
To transfer the environment to the next step you can do the following:

.Propagate environment to next step
----------------------------
$MT_MEGATEST -env2file .ezsteps/${stepname}	  
----------------------------





















.Full example with ezsteps, logpro rules, scripts etc.
-----------------
# You can include a common file
#
[include #{getenv MT_RUN_AREA_HOME}/global-testconfig.inc]

# Use "var" for a scratch pad







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
To transfer the environment to the next step you can do the following:

.Propagate environment to next step
----------------------------
$MT_MEGATEST -env2file .ezsteps/${stepname}	  
----------------------------

Scripts
~~~~~~~

.Specifying scripts inline (best used for only simple scripts)
----------------------------
[scripts]
loaddb #!/bin/bash
  sqlite3 $1 <<EOF
  .mode tabs
  .import $2 data
  .q
  EOF
----------------------------

The above snippet results in the creation of an executable script
called "loaddb" in the test directory. NOTE: every line in the script
must be prefixed with the exact same number of spaces. Lines beginning
with a # will not work as expected. Currently you cannot indent
intermediate lines.

.Full example with ezsteps, logpro rules, scripts etc.
-----------------
# You can include a common file
#
[include #{getenv MT_RUN_AREA_HOME}/global-testconfig.inc]

# Use "var" for a scratch pad

Modified megatest.scm from [c339ebd309] to [c4f77722c1].

224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
  -refdb2dat refdb        : convert refdb to sexp or to format specified by s-dumpmode
                            formats: perl, ruby, sqlite3, csv (for csv the -o param
                            will substitute %s for the sheet name in generating 
                            multiple sheets)
  -o                      : output file for refdb2dat (defaults to stdout)
  -archive cmd            : archive runs specified by selectors to one of disks specified
                            in the [archive-disks] section.
                            cmd: keep-html, restore, save, save-remove
  -generate-html          : create a simple html dashboard for browsing your runs
  -generate-html-structure  : create a top level html veiw to list targets/runs and a Run view within each run directory.  
  -list-run-time          : list time requered to complete runs. It supports following switches
                            -run-patt <patt> -target-patt <patt> -dumpmode <csv,json,plain-text>
  -list-test-time	   : list time requered to complete each test in a run. It following following arguments
                            -runname <patt> -target <patt> -dumpmode <csv,json,plain-text>








|







224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
  -refdb2dat refdb        : convert refdb to sexp or to format specified by s-dumpmode
                            formats: perl, ruby, sqlite3, csv (for csv the -o param
                            will substitute %s for the sheet name in generating 
                            multiple sheets)
  -o                      : output file for refdb2dat (defaults to stdout)
  -archive cmd            : archive runs specified by selectors to one of disks specified
                            in the [archive-disks] section.
                            cmd: keep-html, restore, save, save-remove, get (use -dest to set destination)
  -generate-html          : create a simple html dashboard for browsing your runs
  -generate-html-structure  : create a top level html veiw to list targets/runs and a Run view within each run directory.  
  -list-run-time          : list time requered to complete runs. It supports following switches
                            -run-patt <patt> -target-patt <patt> -dumpmode <csv,json,plain-text>
  -list-test-time	   : list time requered to complete each test in a run. It following following arguments
                            -runname <patt> -target <patt> -dumpmode <csv,json,plain-text>

297
298
299
300
301
302
303

304
305
306
307
308
309
310
			"-logpro"
			"-m"
			"-rerun"

			"-days"
			"-rename-run"
			"-to"

			;; values and messages
			":category"
			":variable"
			":value"
			":expected"
			":tol"
			":units"







>







297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
			"-logpro"
			"-m"
			"-rerun"

			"-days"
			"-rename-run"
			"-to"
			"-dest"
			;; values and messages
			":category"
			":variable"
			":value"
			":expected"
			":tol"
			":units"
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
		      (args:get-arg "-runname"))) ;; eventually get rid of the get-arg calls
	 (testpatt (or (args:get-arg "-testpatt")
		       (and (eq? action 'archive) ;; if it is an archive command fallback to MT_TEST_NAME and MT_ITEMPATH
			    (common:get-full-test-name))
		       (and (eq? action 'kill-runs)
			    "%/%") ;; I'm just guessing that this is correct :(
		       (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")))
		       ))) ;; 
    (cond
     ((not target)
      (debug:print-error 0 *default-log-port* "Missing required parameter for "
			 action ", you must specify -target or -reqtarg")
      (exit 1))
     ((not runname)
      (debug:print-error 0 *default-log-port* "Missing required parameter for "







|







1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
		      (args:get-arg "-runname"))) ;; eventually get rid of the get-arg calls
	 (testpatt (or (args:get-arg "-testpatt")
		       (and (eq? action 'archive) ;; if it is an archive command fallback to MT_TEST_NAME and MT_ITEMPATH
			    (common:get-full-test-name))
		       (and (eq? action 'kill-runs)
			    "%/%") ;; I'm just guessing that this is correct :(
		       (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")))
		       ))) ;;
    (cond
     ((not target)
      (debug:print-error 0 *default-log-port* "Missing required parameter for "
			 action ", you must specify -target or -reqtarg")
      (exit 1))
     ((not runname)
      (debug:print-error 0 *default-log-port* "Missing required parameter for "
1873
1874
1875
1876
1877
1878
1879







1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891

;;======================================================================
;; Archive tests
;;======================================================================
;; Archive tests matching target, runname, and testpatt
(if (args:get-arg "-archive")
    ;; else do a general-run-call







    (general-run-call 
     "-archive"
     "Archive"
     (lambda (target runname keys keyvals)
       (operate-on 'archive target-in: target runname-in: runname ))))

;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================

(if (args:get-arg "-extract-ods")
    (general-run-call







>
>
>
>
>
>
>
|
|
|
|
|







1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899

;;======================================================================
;; Archive tests
;;======================================================================
;; Archive tests matching target, runname, and testpatt
(if (args:get-arg "-archive")
    ;; else do a general-run-call
    (begin
      ;; for the archive get we need to preserve the starting dir as part of the target path
      (if (and (args:get-arg "-dest")
	       (not (equal? (substring (args:get-arg "-dest") 0 1) "/")))
	  (let ((newpath  (conc (current-directory) "/" (args:get-arg "-dest"))))
	    (debug:print-info 1 *default-log-port* "Preserving original path to destination, was " (args:get-arg "-dest") ", now " newpath)
	    (hash-table-set! args:arg-hash "-dest" newpath)))
      (general-run-call 
       "-archive"
       "Archive"
       (lambda (target runname keys keyvals)
	 (operate-on 'archive target-in: target runname-in: runname )))))

;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================

(if (args:get-arg "-extract-ods")
    (general-run-call

Modified runs.scm from [1a91be2483] to [5ad6583ebc].

2103
2104
2105
2106
2107
2108
2109
2110

2111
2112
2113
2114
2115
2116
2117
	 (header       (vector-ref rundat 0))
	 (runs         (vector-ref rundat 1))
	 (states       (if state  (string-split state  ",") '()))
	 (statuses     (if status (string-split status ",") '()))
	 (state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f)))
	 (rp-mutex     (make-mutex))
	 (bup-mutex    (make-mutex))
         (keep-records (args:get-arg "-keep-records"))) ;; used in conjunction with -remove-runs to keep the records, TODO: consolidate this with "mode".


    (let* ((write-access-actions '(remove-runs set-state-status archive run-wait kill-runs))
           (dbfile             (conc  *toppath* "/megatest.db"))
           (readonly-mode      (not (file-write-access? dbfile))))
      (when (and readonly-mode
                 (member action write-access-actions))
        (debug:print-error 0 *default-log-port* "megatest.db is readonly.  Cannot proceed with action ["action"] in which write-access isrequired .")







|
>







2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
	 (header       (vector-ref rundat 0))
	 (runs         (vector-ref rundat 1))
	 (states       (if state  (string-split state  ",") '()))
	 (statuses     (if status (string-split status ",") '()))
	 (state-status (if (string? new-state-status) (string-split new-state-status ",") '(#f #f)))
	 (rp-mutex     (make-mutex))
	 (bup-mutex    (make-mutex))
         (keep-records (args:get-arg "-keep-records")) ;; used in conjunction with -remove-runs to keep the records, TODO: consolidate this with "mode".
	 (test-records '())) ;; for tasks that we wish to operate on all tests in one fell swoop

    (let* ((write-access-actions '(remove-runs set-state-status archive run-wait kill-runs))
           (dbfile             (conc  *toppath* "/megatest.db"))
           (readonly-mode      (not (file-write-access? dbfile))))
      (when (and readonly-mode
                 (member action write-access-actions))
        (debug:print-error 0 *default-log-port* "megatest.db is readonly.  Cannot proceed with action ["action"] in which write-access isrequired .")
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
	 (let* ((run-id    (db:get-value-by-header run header "id"))
		(run-state (db:get-value-by-header run header "state"))
		(run-name  (db:get-value-by-header run header "runname"))
		(tests     (if (not (equal? run-state "locked"))
			       (proc-get-tests run-id)
			       '()))
		(lasttpath "/does/not/exist/I/hope")
    (lastrealpath "/does/not/exist/I/hope")
		(worker-thread #f))
	   (debug:print-info 4 *default-log-port* "runs:operate-on run=" run ", header=" header)
	   (if (not (null? tests))
	       (begin
		 (case action
                   ((kill-runs)
                    (tasks:kill-runner target run-name "%")







|







2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
	 (let* ((run-id    (db:get-value-by-header run header "id"))
		(run-state (db:get-value-by-header run header "state"))
		(run-name  (db:get-value-by-header run header "runname"))
		(tests     (if (not (equal? run-state "locked"))
			       (proc-get-tests run-id)
			       '()))
		(lasttpath "/does/not/exist/I/hope")
		(lastrealpath "/does/not/exist/I/hope")
		(worker-thread #f))
	   (debug:print-info 4 *default-log-port* "runs:operate-on run=" run ", header=" header)
	   (if (not (null? tests))
	       (begin
		 (case action
                   ((kill-runs)
                    (tasks:kill-runner target run-name "%")
2164
2165
2166
2167
2168
2169
2170

2171
2172
2173
2174
2175
2176
2177
2178


2179
2180
2181
2182
2183



2184
2185
2186
2187
2188
2189
2190
		   ((print-run)
		    (debug:print 1 *default-log-port* "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header)
		    action)
		   ((run-wait)
		    (debug:print 1 *default-log-port* "Waiting for run " runkey ", run=" runnamepatt " to complete"))
		   ((archive)
		    (debug:print 1 *default-log-port* "Archiving/restoring (" (args:get-arg "-archive") ") data for run: " runkey " " (db:get-value-by-header run header "runname"))

		    (set! worker-thread
			  (make-thread
			   (lambda ()
			     (case (string->symbol (args:get-arg "-archive"))
			       ((save save-remove keep-html)
				(archive:run-bup (args:get-arg "-archive") run-id run-name tests rp-mutex bup-mutex))
			       ((restore)
				(archive:bup-restore (args:get-arg "-archive") run-id run-name tests rp-mutex bup-mutex))


			       (else 
				(debug:print-error 0 *default-log-port* "unrecognised sub command to -archive. Run \"megatest\" to see help")
				(exit))))
			   "archive-bup-thread"))
		    (thread-start! worker-thread))



		   (else
		    (debug:print-info 0 *default-log-port* "action not recognised " action)))
		 
		 ;; actions that operate on one test at a time can be handled below
		 ;;
		 (let ((sorted-tests     (filter 
					  vector?







>
|
|
|
|
|
|
|
|
>
>
|
|
|
|
|
>
>
>







2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
		   ((print-run)
		    (debug:print 1 *default-log-port* "Printing info for run " runkey ", run=" run ", tests=" tests ", header=" header)
		    action)
		   ((run-wait)
		    (debug:print 1 *default-log-port* "Waiting for run " runkey ", run=" runnamepatt " to complete"))
		   ((archive)
		    (debug:print 1 *default-log-port* "Archiving/restoring (" (args:get-arg "-archive") ") data for run: " runkey " " (db:get-value-by-header run header "runname"))
		    (let ((op (string->symbol (args:get-arg "-archive"))))
		      (set! worker-thread
			    (make-thread
			     (lambda ()
			       (case op
				 ((save save-remove keep-html)
				  (archive:run-bup op run-id run-name tests rp-mutex bup-mutex))
				 ((restore)
				  (archive:bup-restore op run-id run-name tests rp-mutex bup-mutex))
				 ((get) ;;; NOTE: This is a special case. We wish to operate on ALL tests in one go
				  (set! test-records (append tests test-records)))
				 (else 
				  (debug:print-error 0 *default-log-port* "unrecognised sub command " op " for -archive. Run \"megatest\" to see help")
				  (exit))))
			     "archive-bup-thread"))
		      (thread-start! worker-thread)
		      (if (eq? op 'get)
			  (thread-join! worker-thread)) ;; we need the test-records set to not overlap
		      ))
		   (else
		    (debug:print-info 0 *default-log-port* "action not recognised " action)))
		 
		 ;; actions that operate on one test at a time can be handled below
		 ;;
		 (let ((sorted-tests     (filter 
					  vector?
2392
2393
2394
2395
2396
2397
2398

2399
2400
2401
2402
2403
2404
2405
					     (debug:print-info 0 *default-log-port* "Estimating disk space usage for " test-fulln ": " (common:get-disk-space-used ddir)))))))
				(if (not (null? tal))
				    (loop (car tal)(cdr tal))))
			       )))
		       )
		     (if worker-thread (thread-join! worker-thread)))
                   (common:join-backgrounded-threads))))

	   ;; remove the run if zero tests remain
	   (if (eq? action 'remove-runs)
	       (let* ((run-id   (db:get-value-by-header run header "id")) ;; NB// masks run-id from above?
                      (remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t)))
		 (if (null? remtests) ;; no more tests remaining
         ;; Remove the last dir from the path.
         ;; And same for the link-resolved path







>







2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
					     (debug:print-info 0 *default-log-port* "Estimating disk space usage for " test-fulln ": " (common:get-disk-space-used ddir)))))))
				(if (not (null? tal))
				    (loop (car tal)(cdr tal))))
			       )))
		       )
		     (if worker-thread (thread-join! worker-thread)))
                   (common:join-backgrounded-threads))))
	   
	   ;; remove the run if zero tests remain
	   (if (eq? action 'remove-runs)
	       (let* ((run-id   (db:get-value-by-header run header "id")) ;; NB// masks run-id from above?
                      (remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t)))
		 (if (null? remtests) ;; no more tests remaining
         ;; Remove the last dir from the path.
         ;; And same for the link-resolved path
2421
2422
2423
2424
2425
2426
2427
2428


2429
2430
2431
2432
2433
2434
2435
2436
2437
2438

            (debug:print 1 *default-log-port* "Recursively removing real dir " realpath)
            (runs:recursive-delete-with-error-msg realpath)

		       )))))
	 ))
     runs)
    ;; (sqlite3:finalize! (db:delay-if-busy tdbdat))


  )
#t
)

(define (runs:remove-test-directory test mode) ;; remove-data-only)
  (let* ((run-dir       (db:test-get-rundir test))    ;; run dir is from the link tree
	 (real-dir      (if (common:file-exists? run-dir)
			    ;; (resolve-pathname run-dir)
			    (common:nice-path run-dir)
			    #f))







|
>
>
|
|
|







2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448

            (debug:print 1 *default-log-port* "Recursively removing real dir " realpath)
            (runs:recursive-delete-with-error-msg realpath)

		       )))))
	 ))
     runs)
    ;; special case - archive get
    (if (equal? (args:get-arg "-archive") "get")
	(archive:bup-get-data "get" #f #f test-records rp-mutex bup-mutex))
    )
  #t
  )

(define (runs:remove-test-directory test mode) ;; remove-data-only)
  (let* ((run-dir       (db:test-get-rundir test))    ;; run dir is from the link tree
	 (real-dir      (if (common:file-exists? run-dir)
			    ;; (resolve-pathname run-dir)
			    (common:nice-path run-dir)
			    #f))