Megatest

      (debug:print 0 "ERROR: bad value for setenv, key=" key ", value=" val)))

(define home (getenv "HOME"))
(define user (getenv "USER"))

;; GLOBAL GLETCHES
(define *db-keys* #f)

(define *configinfo*   #f)   ;; raw results from setup, includes toppath and table from megatest.config
(define *runconfigdat* #f)   ;; run configs data
(define *configdat*    #f)   ;; megatest.config data
(define *configstatus* #f)   ;; status of data; 'fulldata : all processing done, #f : no data yet, 'partialdata : partial read done
(define *toppath*      #f)
(define *already-seen-runconfig-info* #f)

(define *waiting-queue*     (make-hash-table))
(define *test-meta-updated* (make-hash-table))
(define *globalexitstatus*  0) ;; attempt to work around possible thread issues
(define *passnum*           0) ;; when running track calls to run-tests or similar
(define *write-frequency*   (make-hash-table)) ;; run-id => (vector (current-seconds) 0))
(define *alt-log-file* #f)  ;; used by -log
(define *common:denoise*    (make-hash-table)) ;; for low noise printing

			    "%"))
	 (testpatt    (or (and (equal? args-testpatt "%")
			       rtestpatt)
			  args-testpatt)))
    (if rtestpatt (debug:print-info 0 "TESTPATT from runconfigs: " rtestpatt))
    testpatt))

(define (common:get-linktree)
  (or (getenv "MT_LINKTREE")
      (if *configdat*
	  (configf:lookup *configdat* "setup" "linktree"))))

(define (common:args-get-runname)
  (let ((res (or (args:get-arg "-runname")
		 (args:get-arg ":runname")
		 (getenv "MT_RUNNAME"))))
    ;; (if res (set-environment-variable "MT_RUNNAME" res)) ;; not sure if this is a good idea. side effect and all ...
    res))

(define (common:args-get-target #!key (split #f))
  (let* ((keys    (if *configdat* (keys:config-get-fields *configdat*) '()))
	 (numkeys (length keys))
	 (target  (if (args:get-arg "-reqtarg")
		      (args:get-arg "-reqtarg")
		      (if (args:get-arg "-target")
			  (args:get-arg "-target")
			  (getenv "MT_TARGET"))))
	 (tlist   (if target (string-split target "/" #t) '()))

		 0))

(if (args:get-arg "-h")
    (begin
      (print help)
      (exit)))

(if (not (launch:setup))
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

(define *useserver* (cond
		     ((args:get-arg "-use-local") #f)
		     ((configf:lookup *configdat* "dashboard" "use-server")

	(if same-time
	    (string>? item-path1 item-path2)
	    test1-older)
	(if same-time
	    (string>? test-name1 test-name2)
	    test1-older))))
    
;; create a virtual table of all the tests
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
(define (update-rundat runnamepatt numruns testnamepatt keypatts)
  (let* ((referenced-run-ids '())
	 (allruns     (if *useserver*
			  (rmt:get-runs runnamepatt numruns *start-run-offset* keypatts)
			  (db:get-runs *dbstruct-local* runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2))
				      *start-run-offset* keypatts)))

;;  'old2new      - sync megatest.db records to .db/{main,1,2 ...}.db
;;  'new2old      - sync .db/{main,1,2,3 ...}.db to megatest.db
;;  'closeall     - close all opened dbs
;;
;;  run-ids: '(1 2 3 ...) or #f (for all)
;;
(define (db:multi-db-sync run-ids . options)
  (let* ((toppath  (launch:setup))
	 (dbstruct (if toppath (make-dbr:dbstruct path: toppath) #f))
	 (mtdb     (if toppath (db:open-megatest-db)))
	 (allow-cleanup (if run-ids #f #t))
	 (run-ids  (if run-ids 
		       run-ids
		       (if toppath (begin
				     (db:delay-if-busy mtdb)

ASCPATH = $(shell which asciidoc)
EXEPATH = $(shell readlink -f $(ASCPATH))
BINPATH = $(shell dirname $(EXEPATH))
DISPATH = $(shell dirname $(BINPATH))

# broad_goals.csv  needed_features.csv : tables/*.dat
#         ./refdb2csv tables

# in a makefile recipe, $< denotes the first dependency; $@ the target

<div class="content monospaced">
<pre>runscript main.csh</pre>
</div></div>
</div>
</div>
<div class="sect2">
<h3 id="_requirements_section">Requirements section</h3>
<div class="listingblock">

<div class="title">Header</div>
<div class="content monospaced">
<pre>[requirements]</pre>
</div></div>

<div class="sect3">
<h4 id="_wait_on_other_tests">Wait on Other Tests</h4>
<div class="listingblock">
<div class="content monospaced">
<pre># A normal waiton waits for the prior tests to be COMPLETED
# and PASS, CHECK or WAIVED
waiton test1 test2</pre>

"itemmatch" are synonyms.</p></div>
<div class="listingblock">
<div class="content monospaced">
<pre>[requirements]
mode itemmatch</pre>
</div></div>
</div>
</div>
<div class="sect2">
<h3 id="_overriding_enviroment_variables">Overriding Enviroment Variables</h3>
<div class="paragraph"><p>Override variables before starting the test. Can include files (perhaps generated by megatest -envdelta or similar).</p></div>
<div class="listingblock">
<div class="content monospaced">
<pre>[pre-launch-env-vars]
VAR1 value1

# Get some generated settings
[include ../generated-vars.config]

# Use this trick to unset variables
#{scheme (unsetenv "FOOBAR")}</pre>
</div></div>
</div>
<div class="sect2">
<h3 id="_itemmap_handling">Itemmap Handling</h3>
<div class="paragraph"><p>For cases were the dependent test has a similar but not identical
itempath to the downstream test an itemmap can allow for itemmatch
mode</p></div>
<div class="listingblock">

<div class="title">Testconfig for Test C</div>
<div class="content monospaced">
<pre>[requirements]
waiton A B

[itemmap]
A (\d+)/aa aa/\1
B (\d+)/bb</pre>
</div></div>
<div class="listingblock">
<div class="title">Testconfig for Test D</div>
<div class="content monospaced">
<pre>[requirements]
waiton C
itemmap (\d+)/res \1/aa</pre>

<div class="listingblock">
<div class="title">Autogeneration waiton list for dynamic flow dependency trees</div>
<div class="content monospaced">
<pre>[requirements]
# With a toplevel test you may wish to generate your list
# of tests to run dynamically
#
waiton #{shell get-valid-tests-to-run.sh}</pre>
</div></div>
</div>
<div class="sect3">
<h4 id="_run_time_limit_2">Run time limit</h4>
<div class="listingblock">
<div class="content monospaced">
<pre>[requirements]
runtimelim 1h 2m 3s  # this will automatically kill the test if it runs for more than 1h 2m and 3s</pre>
</div></div>
</div>
<div class="sect3">
<h4 id="_skip">Skip</h4>
<div class="paragraph"><p>A test with a skip section will conditional skip running.</p></div>
<div class="listingblock">
<div class="title">Skip section example</div>

# Archives will be organised under these paths like this:
#  <testsuite>/<creationdate>
# Within the archive the data is structured like this:
#  <target>/<runname>/<test>/
archive0 /mfs/myarchive-data/adisk1</pre>
</div></div>
</div>
</div>
<div class="sect1">
<h2 id="_handling_environment_variables">Handling Environment Variables</h2>
<div class="sectionbody">
<div class="paragraph"><p>It is often necessary to capture and or manipulate environment
variables. Megatest has some facilities built in to help.</p></div>
<div class="sect2">
<h3 id="_capture_variables">Capture variables</h3>
<div class="listingblock">
<div class="title">Commands</div>
<div class="content monospaced">
<pre># capture the current enviroment into a db called envdat.db under
# the context "before"
megatest -envcap before

# capture the current environment into a db called startup.db with
# context "after"
megatest -envcap after startup.db

# write the diff from before to after
megatest -envdelta before-after -dumpmode bash</pre>
</div></div>
<div class="paragraph"><p>Dump modes include bash, csh and config. You can include config data
into megatest.config or runconfigs.config.</p></div>
<div class="listingblock">
<div class="title">Example of generating and using config data</div>
<div class="content monospaced">
<pre>megatest -envcap original
# do some stuff here
megatest -envcap munged
megatest -envdelta original-munged -dumpmode ini -o modified.config</pre>
</div></div>
<div class="paragraph"><p>Then in runconfigs.config</p></div>
<div class="listingblock">
<div class="title">Example of using modified.config in a testconfig</div>
<div class="content monospaced">
<pre>cat testconfig

[pre-launch-env-vars]
[include modified.config]</pre>
</div></div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_programming_api">Programming API</h2>
<div class="sectionbody">
<div class="paragraph"><p>These routines can be called from the megatest repl.</p></div>
<table class="tableblock frame-topbot grid-all"

</div>
</div>
</div>
<div id="footnotes"><hr></div>
<div id="footer">
<div id="footer-text">
Version 1.0<br>
Last updated 2015-09-13 12:16:43 MST

</div>
</div>
</body>
</html>

-------------------
runscript main.csh
-------------------

Requirements section
~~~~~~~~~~~~~~~~~~~~

.Header


-------------------
[requirements]
-------------------

Wait on Other Tests
^^^^^^^^^^^^^^^^^^^

was historically called "itemwait" mode. The terms "itemwait" and
"itemmatch" are synonyms.

-------------------
[requirements]
mode itemmatch
-------------------

Overriding Enviroment Variables
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Override variables before starting the test. Can include files (perhaps generated by megatest -envdelta or similar).

--------------------
[pre-launch-env-vars]
VAR1 value1

# Get some generated settings
[include ../generated-vars.config]

# Use this trick to unset variables
#{scheme (unsetenv "FOOBAR")}
--------------------

Itemmap Handling
~~~~~~~~~~~~~~~~

For cases were the dependent test has a similar but not identical
itempath to the downstream test an itemmap can allow for itemmatch
mode

.Testconfig for Test C
----------------------
[requirements]
waiton A B

[itemmap]
A (\d+)/aa aa/\1
B (\d+)/bb 
----------------------

.Testconfig for Test D
----------------------
[requirements]
waiton C
itemmap (\d+)/res \1/aa
----------------------

# Archives will be organised under these paths like this:
#  <testsuite>/<creationdate>
# Within the archive the data is structured like this:
#  <target>/<runname>/<test>/
archive0 /mfs/myarchive-data/adisk1
--------------

Handling Environment Variables
------------------------------

It is often necessary to capture and or manipulate environment
variables. Megatest has some facilities built in to help.

Capture variables
~~~~~~~~~~~~~~~~~

.Commands
------------------------------
# capture the current enviroment into a db called envdat.db under
# the context "before"
megatest -envcap before

# capture the current environment into a db called startup.db with 
# context "after"
megatest -envcap after startup.db

# write the diff from before to after
megatest -envdelta before-after -dumpmode bash
------------------------------

Dump modes include bash, csh and config. You can include config data
into megatest.config or runconfigs.config.

.Example of generating and using config data
------------------------------
megatest -envcap original
# do some stuff here
megatest -envcap munged
megatest -envdelta original-munged -dumpmode ini -o modified.config
------------------------------

Then in runconfigs.config

.Example of using modified.config in a testconfig
------------------------------
cat testconfig

[pre-launch-env-vars]
[include modified.config]
------------------------------

Programming API
---------------

These routines can be called from the megatest repl. 

.API Server Management Calls

                    val TEXT NOT NULL,
                       CONSTRAINT envvars_constraint UNIQUE (context,var))"))))
    (set-busy-handler! db (busy-timeout 10000))
    db))

;; save vars in given context, this is NOT incremental by default
;;
(define (env:save-env-vars db context #!key (incremental #f)(vardat #f))
  (with-transaction
   db
   (lambda ()
     ;; first clear out any vars for this context
     (if (not incremental)(exec (sql db "DELETE FROM envvars WHERE context=?") context))
     (for-each
      (lambda (varval)
	(let ((var (car varval))
	      (val (cdr varval)))
	  (if incremental (exec (sql db "DELETE FROM envvars WHERE context=? AND var=?") context var))
	  (exec (sql db "INSERT INTO envvars (context,var,val) VALUES (?,?,?)") context var val)))
	(if vardat
	    (hash-table->alist vardat)
	    (get-environment-variables))))))

;; merge contexts in the order given
;;  - each context is applied in the given order
;;  - variables in the paths list are split on the separator and the components
;;    merged using simple delta addition
;;    returns a hash of the merged vars
;;
(define (env:merge-contexts db basecontext contexts paths)
  (let ((result (make-hash-table)))
    (for-each
     (lambda (context)
       (query
	(for-each-row
	 (lambda (row)
	   (let ((var  (car row))
		 (val  (cadr row)))
	     (hash-table-set! result var 
			      (if (and (hash-table-ref/default results var #f)
				       (assoc var paths)) ;; this var is a path and there is a previous path
				  (let ((sep (cadr (assoc var paths))))
				    (env:merge-path-envvar sep (hash-table-ref results var) valb))
				  valb)))))
	(sql db "SELECT var,val FROM envvars WHERE context=?")
	context))
     contexts)
    result))

;;  get list of removed variables between two contexts
;;
(define (env:get-removed db contexta contextb)
  (let ((result (make-hash-table)))
    (query
     (for-each-row
      (lambda (row)
	(let ((var  (car row))
	      (val  (cadr row)))
	  (hash-table-set! result var val))))
     (sql db "SELECT var,val FROM envvars WHERE context=? AND var NOT IN (SELECT var FROM envvars WHERE context=?)")
     contexta contextb)
    result))

;;  get list of variables added to contextb from contexta
;;
(define (env:get-added db contexta contextb)
  (let ((result (make-hash-table)))
    (query
     (for-each-row
      (lambda (row)
	(let ((var  (car row))
	      (val  (cadr row)))
	  (hash-table-set! result var val))))
     (sql db "SELECT var,val FROM envvars WHERE context=? AND var NOT IN (SELECT var FROM envvars WHERE context=?)")
     contextb contexta)
    result))

;;  get list of variables in both contexta and contexb that have been changed
;;
(define (env:get-changed db contexta contextb)
  (let ((result (make-hash-table)))


    (query
     (for-each-row
      (lambda (row)
	(let ((var  (car row))
	      (val  (cadr row)))








	  (hash-table-set! result var val))))

     (sql db "SELECT var,val FROM envvars AS a WHERE context=? AND val != (SELECT val FROM envvars WHERE var=a.var AND context=?)")

     contexta contextb)
    result))

;;
(define (env:blind-merge l1 l2)
  (if (null? l1) l2
      (if (null? l2) l1
	  (cons (car l1) (cons (car l2) (env:blind-merge (cdr l1) (cdr l2)))))))

;; given a before and an after envvar calculate a new merged path
;;
(define (env:merge-path-envvar separator patha pathb)
  (let* ((patha-parts  (string-split patha separator))
	 (pathb-parts  (string-split pathb separator))
	 (common-parts (lset-intersection equal? patha-parts pathb-parts))
	 (final        (delete-duplicates ;; env:blind-merge 
			(append pathb-parts common-parts patha-parts))))
;;     (print "BEFORE:   " (string-intersperse patha-parts  "\n       "))
;;     (print "AFTER:    " (string-intersperse pathb-parts  "\n       "))
;;     (print "COMMON:   " (string-intersperse common-parts "\n       "))
    (string-intersperse final separator)))

(define (env:process-path-envvar varname separator patha pathb)



  (let ((newpath (env:merge-path-envvar separator patha pathb)))
    (setenv varname newpath)))

(define (env:have-context db context)
  (> (query fetch-value (sql db "SELECT count(id) FROM envvars WHERE context=?") context)
     0))

;; this is so the calling block does not need to import sql-de-lite
(define (env:close-database db)
  (close-database db))

(define (env:lazy-hash-table->alist indat)
  (if (hash-table? indat)
      (let ((dat (hash-table->alist indat)))
	(if (null? dat)
	    #f 
	    dat))
      #f))

(define (env:print added removed changed)
  (let ((a  (env:lazy-hash-table->alist added))
	(r  (env:lazy-hash-table->alist removed))
	(c  (env:lazy-hash-table->alist changed)))
    (case (if (args:get-arg "-dumpmode")
	      (string->symbol (args:get-arg "-dumpmode"))
	      'bash)
      ((bash)
       (if a
	   (begin
	     (print "# Added vars")
	     (map (lambda (dat)(print "export " (car dat) "=" (cdr dat)))
		  (hash-table->alist added))))
       (if r
	   (begin
	     (print "# Removed vars")
	     (map (lambda (dat)(print "unset " (car dat)))
		  (hash-table->alist removed))))
       (if c
	   (begin
	     (print "# Changed vars")
	     (map (lambda (dat)(print "export " (car dat) "=" (cdr dat)))
		  (hash-table->alist changed)))))
      ((csh)
       (if a
	   (begin
	     (print "# Added vars")
	     (map (lambda (dat)(print "setenv " (car dat) " " (cdr dat)))
		  (hash-table->alist added))))
       (if r
	   (begin
	     (print "# Removed vars")
	     (map (lambda (dat)(print "unsetenv " (car dat)))
		  (hash-table->alist removed))))
       (if c
	   (begin
	     (print "# Changed vars")
	     (map (lambda (dat)(print "setenv " (car dat) " " (cdr dat)))
		  (hash-table->alist changed)))))
      ((config ini)
       (if a
	   (begin
	     (print "# Added vars")
	     (map (lambda (dat)(print (car dat) " " (cdr dat)))
		  (hash-table->alist added))))
       (if r
	   (begin
	     (print "# Removed vars")
	     (map (lambda (dat)(print "#{scheme (unsetenv \"" (car dat) "\")}"))
		  (hash-table->alist removed))))
       (if c
	   (begin
	     (print "# Changed vars")
	     (map (lambda (dat)(print (car dat) " " (cdr dat)))
		  (hash-table->alist changed)))))
      (else
       (debug:print 0 "ERROR: No dumpmode specified, use -dumpmode [bash|csh|config]")))))

		  (debug:print 0 "INFO: Not starting job yet - directory " top-path " not found")
		  (thread-sleep! 10)
		  (loop (+ count 1)))))

	  (let ((sighand (lambda (signum)
			   ;; (signal-mask! signum) ;; to mask or not? seems to cause issues in exiting
			   (if (eq? signum signal/stop)
			       (debug:print 0 "ERROR: attempt to STOP process. Exiting."))
			   (set! *time-to-exit* #t)
			   (print "Received signal " signum ", cleaning up before exit. Please wait...")
			   (let ((th1 (make-thread (lambda ()
						     (tests:test-force-state-status! run-id test-id "INCOMPLETE" "KILLED")
						     (print "Killed by signal " signum ". Exiting")
						     (thread-sleep! 1)
						     (exit 1))))

	      (debug:print 0 "ERROR: test state is " (db:test-get-state test-info) ", cannot proceed")
	      (exit))))
	  
	  (debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name))
	  (set! keys       (rmt:get-keys))
	  ;; (runs:set-megatest-env-vars run-id inkeys: keys inkeyvals: keyvals) ;; these may be needed by the launching process
	  ;; one of these is defunct/redundant ...
	  (if (not (launch:setup force: #t))
	      (begin
		(debug:print 0 "Failed to setup, exiting") 
		;; (sqlite3:finalize! db)
		;; (sqlite3:finalize! tdb)
		(exit 1)))
	  (change-directory *toppath*) 

	  ;; NOTE: Current order is to process runconfigs *before* setting the MT_ vars. This 
	  ;;       seems non-ideal but could well break stuff
	  ;;    BUG? BUG? BUG?
	  
	  (let ((rconfig (full-runconfigs-read))) ;; (read-config (conc  *toppath* "/runconfigs.config") #f #t sections: (list "default" target))))
	    ;; (setup-env-defaults (conc *toppath* "/runconfigs.config") run-id (make-hash-table) keyvals target)
	    ;; (set-run-config-vars run-id keyvals target) ;; (db:get-target db run-id))
	    ;; Now have runconfigs data loaded, set environment vars
	    (for-each (lambda (section)
			(for-each (lambda (varval)
				    (let ((var (car varval))

				 ;; then, if runscript ran ok (or did not get called)
				 ;; do all the ezsteps (if any)
				 (if ezsteps
				     (let* ((testconfig ;; (read-config (conc work-area "/testconfig") #f #t environ-patt: "pre-launch-env-vars")) ;; FIXME??? is allow-system ok here?
					     ;; NOTE: it is tempting to turn off force-create of testconfig but dynamic
					     ;;       ezstep names need a full re-eval here.
					     (tests:get-testconfig test-name tconfigreg #t force-create: #t)) ;; 'return-procs)))
					    (ezstepslst (if (hash-table? testconfig)
							    (hash-table-ref/default testconfig "ezsteps" '())
							    #f)))
				       (if testconfig
					   (hash-table-set! *testconfigs* test-name testconfig) ;; cached for lazy reads later ...
					   (begin
					     ;; got here but there are race condiitions - re-do all setup and try one more time
					     (if (launch:setup)
						 (begin
						   (launch:cache-config)
						   (set! testconfig (full-runconfigs-read))) ;; redunantly redundant, but does it resolve the race?
					     (debug:print 0 "WARNING: no testconfig found for " test-name " in search path:\n  "
							  (string-intersperse (tests:get-tests-search-path *configdat*) "\n  ")))))
				       ;; after all that, still no testconfig? Time to abort
				       (if (not testconfig)
					   (begin
					     (debug:print 0 "ERROR: Failed to resolve megatest.config, runconfigs.config and testconfig issues. Giving up now")
					     (exit 1)))
				       (if (not (file-exists? ".ezsteps"))(create-directory ".ezsteps"))
				       ;; if ezsteps was defined then we are sure to have at least one step but check anyway
				       (if (not (> (length ezstepslst) 0))
					   (debug:print 0 "ERROR: ezsteps defined but ezstepslst is zero length")
					   (let loop ((ezstep (car ezstepslst))
						      (tal    (cdr ezstepslst))
						      (prevstep #f))

	      (rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id)))
	    (mutex-unlock! m)
	    (debug:print 2 "Output from running " fullrunscript ", pid " (launch:einf-pid exit-info) " in work area " 
			 work-area ":\n====\n exit code " (launch:einf-exit-code exit-info) "\n" "====\n")
	    (if (not (launch:einf-exit-status exit-info))
		(exit 4)))))))

;; gather available information, if legit read configs in this order:

;;
;;   if have cache;
;;      read it a return it
;;   else
;;     megatest.config     (do not cache)
;;     runconfigs.config   (cache if all vars avail)
;;     megatest.config     (cache if all vars avail)
;;   returns:
;;     *toppath*
;;   side effects:
;;     sets; *configdat*    (megatest.config info)


;;           *runconfigdat* (runconfigs.config info)
;;           *configstatus* (status of the read data)
;;
(define (launch:setup #!key (force #f))
  (let* ((runname  (common:args-get-runname))
	 (target   (common:args-get-target))
	 (linktree (common:get-linktree))

	 (rundir   (if (and runname target linktree)(conc linktree "/" target "/" runname) #f))
	 (mtcachef (and rundir (conc rundir "/" ".megatest.cfg-"  megatest-version "-" megatest-fossil-hash)))
	 (rccachef (and rundir (conc rundir "/" ".runconfigs.cfg-"  megatest-version "-" megatest-fossil-hash)))
	 (cancreate (and rundir (file-exists? rundir)(file-write-access? rundir))))
    (print "runname: " runname " target: " target " mtcachef: " mtcachef " rccachef: " rccachef)
    (cond
     ;; data was read and cached and available in *configstatus*
     ((eq? *configstatus* 'fulldata)
      *toppath*)
     ;; if mtcachef exists just read it
     ((and mtcachef (file-exists? mtcachef))
      (set! *configdat*    (configf:read-alist mtcachef))
      (set! *runconfigdat* (configf:read-alist rccachef))
      (set! *configinfo*   (list *configdat*  (get-environment-variable "MT_RUN_AREA_HOME")))
      (set! *configstatus* 'fulldata)
      *toppath*)
     ;; we have all the info needed to fully process runconfigs and megatest.config
     (mtcachef              
      (let ((first-pass (find-and-read-config 
				  (or (args:get-arg "-config") "megatest.config")
				  environ-patt: "env-override"
				  given-toppath: (get-environment-variable "MT_RUN_AREA_HOME")
				  pathenvvar: "MT_RUN_AREA_HOME")))
	(if first-pass
	    (begin
	      (set! *configdat*  (car first-pass))
	      (set! *configinfo* first-pass)
	      (set! *toppath*    (cadr first-pass))
	      ;; the seed read is done, now read runconfigs, cache it then read megatest.config one more time and cache it
	      (let* ((keys     (rmt:get-keys))
		     (key-vals (if target (keys:target->keyval keys target) #f))
		     (sections (if target (list "default" target) #f)) ;; for runconfigs
		     (linktree (or (getenv "MT_LINKTREE")
				   (if *configdat* (configf:lookup *configdat* "setup" "linktree") #f)))
		     (runconfigdat (begin
				     (setenv "MT_RUN_AREA_HOME" *toppath*)
				     (if key-vals
					 (for-each (lambda (kt)
						     (setenv (car kt) (cadr kt)))
						   key-vals))
				     (read-config (conc *toppath* "/runconfigs.config") #f #t sections: sections))))
		(if cancreate (configf:write-alist runconfigdat rccachef))
		(set! *runconfigdat* runconfigdat)
		(let ((second-pass (find-and-read-config 
				    (or (args:get-arg "-config") "megatest.config")
				    environ-patt: "env-override"
				    given-toppath: (get-environment-variable "MT_RUN_AREA_HOME")
				    pathenvvar: "MT_RUN_AREA_HOME")))
		  (if cancreate (configf:write-alist (car second-pass) mtcachef))
		  (set! *configdat* (car second-pass))
		  (set! *toppath*   (cadr second-pass))
		  (if cancreate (set! *configstatus* 'fulldata)))))
	    ;; no configs found? should not happen but let's try to recover gracefully, return an empty hash-table
	    (set! *configdat* (make-hash-table))
	    )))
     ;; else read what you can and set the flag accordingly
     (else
      (let* ((cfgdat   (find-and-read-config 
			(or (args:get-arg "-config") "megatest.config")
			environ-patt: "env-override"
			given-toppath: (get-environment-variable "MT_RUN_AREA_HOME")
			pathenvvar: "MT_RUN_AREA_HOME"))
	     (sections (if target (list "default" target) #f))
	     (rdat     (read-config (conc (or *toppath* (get-environment-variable "MT_RUN_AREA_HOME")(cadr cfgdat))
					  "/runconfigs.config") #f #t sections: sections)))
	(set! *configinfo*   cfgdat)
	(set! *configdat*    (car cfgdat))
	(set! *runconfigdat* rdat)
	(set! *toppath*      (cadr cfgdat))



	(set! *configstatus* 'partial))))
    ;; final house keeping


    (let* ((keys     (rmt:get-keys))
	   (key-vals (if target (keys:target->keyval keys target) #f))
	   (sections (if target (list "default" target) #f)) ;; for runconfigs
	   (linktree (or (getenv "MT_LINKTREE")
			 (if *configdat* (configf:lookup *configdat* "setup" "linktree") #f))))
      (if linktree
	  (if (not (file-exists? linktree))
	      (begin
		(handle-exceptions
		 exn
		 (begin
		   (debug:print 0 "ERROR: Something went wrong when trying to create linktree dir at " linktree)
		   (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
		   (exit 1))
		 (create-directory linktree #t))))
	  (begin
	    (debug:print 0 "ERROR: linktree not defined in [setup] section of megatest.config")
	    ;; (exit 1)











	    )))
    (if (and *toppath*
	     (directory-exists? *toppath*))
	(setenv "MT_RUN_AREA_HOME" *toppath*)
	(begin
	  (debug:print 0 "ERROR: failed to find the top path to your Megatest area.")))


    *toppath*))





























(define (get-best-disk confdat testconfig)
  (let* ((disks   (or (and testconfig (hash-table-ref/default testconfig "disks" #f))
		      (hash-table-ref/default confdat "disks" #f)))
	 (minspace (let ((m (configf:lookup confdat "setup" "minspace")))
		     (string->number (or m "10000")))))
    (if disks 

			"-transport"
			"-kill-server"
			"-port"
			"-extract-ods"
			"-pathmod"
			"-env2file"
			"-envcap"
			"-envdelta"
			"-setvars"
			"-set-state-status"
			"-set-run-status"
			"-debug" ;; for *verbosity* > 2
			"-gen-megatest-test"
			"-override-timeout"
			"-test-files"  ;; -test-paths is for listing all

			"-logging"
			"-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only
		       )
		 args:arg-hash
		 0))

;; Add args that use remargs here
;;
(if (and (not (null? remargs))
	 (not (or
	       (args:get-arg "-runstep")
	       (args:get-arg "-envcap")
	       (args:get-arg "-envdelta")
	       )
	      ))
    (debug:print 0 "ERROR: Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv))  " ")))

;; immediately set MT_TARGET if -reqtarg or -target are available
;;
(let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target"))))
  (if targ (setenv "MT_TARGET" targ)))

(if (args:get-arg "-env2file")
    (begin
      (save-environment-as-files (args:get-arg "-env2file"))
      (set! *didsomething* #t)))

(if (args:get-arg "-list-disks")
    (let ((toppath (launch:setup)))
      (print 
       (string-intersperse 
	(map (lambda (x)
	       (string-intersperse 
		x
		" => "))
	     (common:get-disks *configdat*))

;;       (set! *did-something* #t)
;; 	      (begin
;; 		(print ((rpc:procedure 'testing (car host-port)(cadr host-port))))
;; 		(case (server:get-transport)
;; 		  ((http)(http:ping run-id host-port))
;; 		  ((rpc) (rpc:procedure 'server:login (car host-port)(cadr host-port));;  *toppath*)) ;; (rpc-transport:ping  run-id (car host-port)(cadr host-port)))
;; 		  (else  (debug:print 0 "ERROR: No transport set")(exit)))))

;;======================================================================
;; Capture, save and manipulate environments
;;======================================================================

;; NOTE: Keep these above the section where the server or client code is setup

(let ((envcap (args:get-arg "-envcap")))
  (if envcap
      (let* ((db      (env:open-db (if (null? remargs) "envdat.db" (car remargs)))))
	(env:save-env-vars db envcap)
	(env:close-database db)
	(set! *didsomething* #t))))

;; delta "language" will eventually be res=a+b-c but for now it is just res=a-b 
;;
(let ((envdelta (args:get-arg "-envdelta")))
  (if envdelta
      (let ((match (string-split envdelta "-")));; (string-match "([a-z0-9_]+)=([a-z0-9_\\-,]+)" envdelta)))
	(if (not (null? match))
	    (let* ((db        (env:open-db (if (null? remargs) "envdat.db" (car remargs))))
		   ;; (resctx    (cadr match))
		   ;; (equn      (caddr match))
		   (parts     match) ;; (string-split equn "-"))
		   (minuend   (car parts))
		   (subtraend (cadr parts))
		   (added     (env:get-added   db minuend subtraend))
		   (removed   (env:get-removed db minuend subtraend))
		   (changed   (env:get-changed db minuend subtraend)))
	      ;; (pp (hash-table->alist added))
	      ;; (pp (hash-table->alist removed))
	      ;; (pp (hash-table->alist changed))
	      (if (args:get-arg "-o")
		  (with-output-to-file
		      (args:get-arg "-o")
		    (lambda ()
		      (env:print added removed changed)))
		  (env:print added removed changed))
	      (env:close-database db)
	      (set! *didsomething* #t))
	    (debug:print 0 "ERROR: Parameter to -envdelta should be new=star-end")))))



;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;;   we start the server if not running else start the client thread
;;======================================================================

(if (args:get-arg "-server")

    ;; Server? Start up here.
    ;;
    (let ((tl        (launch:setup))
	  (run-id    (and (args:get-arg "-run-id")
			  (string->number (args:get-arg "-run-id")))))
      (if run-id
	  (begin
	    (server:launch run-id)
	    (set! *didsomething* #t))
	  (debug:print 0 "ERROR: server requires run-id be specified with -run-id")))

    ;; Not a server? This section will decide how to communicate
    ;;
    ;;  Setup client for all expect listed here
    (if (null? (lset-intersection 
		equal?
		(hash-table-keys args:arg-hash)
		'("-list-servers"
		  "-stop-server"
		  "-show-cmdinfo"
		  "-list-runs"
		  "-ping")))
	(if (launch:setup)
	    (let ((run-id    (and (args:get-arg "-run-id")
				  (string->number (args:get-arg "-run-id")))))
	      ;; (set! *fdb*   (filedb:open-db (conc *toppath* "/db/paths.db")))
	      ;; if not list or kill then start a client (if appropriate)
	      (if (or (args-defined? "-h" "-version" "-gen-megatest-area" "-gen-megatest-test")
		      (eq? (length (hash-table-keys args:arg-hash)) 0))
		  (debug:print-info 1 "Server connection not needed")
		  (begin
		    ;; (if run-id 
		    ;;     (client:launch run-id) 
		    ;;     (client:launch 0)      ;; without run-id we'll start a server for "0"
		    #t
		    ))))))

;; MAY STILL NEED THIS
;;		       (set! *megatest-db* (make-dbr:dbstruct path: *toppath* local: #t))))))))))

(if (or (args:get-arg "-list-servers")
	(args:get-arg "-stop-server"))
    (let ((tl (launch:setup)))
      (if tl 
	  (let* ((tdbdat  (tasks:open-db))
		 (servers (tasks:get-all-servers (db:delay-if-busy tdbdat)))
		 (fmtstr  "~5a~12a~8a~20a~24a~10a~10a~10a~10a\n")
		 (servers-to-kill '())
		 (killinfo   (args:get-arg "-stop-server"))
		 (khost-port (if killinfo (if (substring-index ":" killinfo)(string-split ":") #f) #f))

		   targets))
	((json)
	 (json-write targets))
	(else
	 (debug:print 0 "ERROR: dump output format " (args:get-arg "-dumpmode") " not supported for -list-targets")))
      (set! *didsomething* #t)))

;; get the runconfigs
;;
(define (full-runconfigs-read)
  (if (eq? *configstatus* 'fulldata)
      *runconfigdat*
      (begin
	(launch:setup)
	*runconfigdat*)))

;;   (let* ((rundir (if (and (getenv "MT_LINKTREE")(getenv "MT_TARGET")(getenv "MT_RUNNAME"))
;; 		     (conc (getenv "MT_LINKTREE") "/" (getenv "MT_TARGET") "/" (getenv "MT_RUNNAME"))
;; 		     #f))
;; 	 (cfgf   (if rundir (conc rundir "/.runconfig." megatest-version "-" megatest-fossil-hash) #f)))
;;     (if (and cfgf
;; 	     (file-exists? cfgf)
;; 	     (file-write-access? cfgf))
;; 	(configf:read-alist cfgf)
;; 	(let* ((keys   (rmt:get-keys))
;; 	       (target (common:args-get-target))
;; 	       (key-vals (if target (keys:target->keyval keys target) #f))
;; 	       (sections (if target (list "default" target) #f))
;; 	       (data     (begin
;; 			   (setenv "MT_RUN_AREA_HOME" *toppath*)
;; 			   (if key-vals
;; 			       (for-each (lambda (kt)
;; 					   (setenv (car kt) (cadr kt)))
;; 					 key-vals))
;; 			   (read-config (conc *toppath* "/runconfigs.config") #f #t sections: sections))))
;; 	  (if (and rundir ;; have all needed variabless
;; 		   (directory-exists? rundir)
;; 		   (file-write-access? rundir))
;; 	      (begin
;; 		(configf:write-alist data cfgf)
;; 		;; force re-read of megatest.config - this resolves circular references between megatest.config
;; 		(launch:setup force: #t)
;; 		(launch:cache-config))) ;; we can safely cache megatest.config since we have a valid runconfig
;; 	  data))))


(if (args:get-arg "-show-runconfig")
    (let ((tl (launch:setup)))
      (push-directory *toppath*)
      (let ((data (full-runconfigs-read)))
	;; keep this one local
	(cond
	 ((and (args:get-arg "-section")
	       (args:get-arg "-var"))
	  (let ((val (or (configf:lookup data (args:get-arg "-section")(args:get-arg "-var"))

	  (configf:config->ini data))
	 (else
	  (debug:print 0 "ERROR: -dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
	(set! *didsomething* #t))
      (pop-directory)))

(if (args:get-arg "-show-config")
    (let ((tl   (launch:setup))
	  (data *configdat*)) ;; (read-config "megatest.config" #f #t)))
      (push-directory *toppath*)
      ;; keep this one local
      (cond 
       ((and (args:get-arg "-section")
	     (args:get-arg "-var"))
	(let ((val (configf:lookup data (args:get-arg "-section")(args:get-arg "-var"))))

;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
;; IDEA: megatest list -runname blah% ...
;;
(if (or (args:get-arg "-list-runs")
	(args:get-arg "-list-db-targets"))
    (if (launch:setup)
	(let* (;; (dbstruct    (make-dbr:dbstruct path: *toppath* local: (args:get-arg "-local")))
	       (runpatt     (args:get-arg "-list-runs"))
	       (testpatt    (common:args-get-testpatt #f))
	       ;; (if (args:get-arg "-testpatt") 
	       ;;  	        (args:get-arg "-testpatt") 
	       ;;  	        "%"))
	       (keys        (rmt:get-keys)) ;; (db:get-keys dbstruct))

		  (ods:list->ods tempdir ouf sheets))))
	  ;; (system (conc "rm -rf " tempdir))
	  (set! *didsomething* #t))))

;; Don't think I need this. Incorporated into -list-runs instead
;;
;; (if (and (args:get-arg "-since")
;; 	 (launch:setup))
;;     (let* ((since-time (string->number (args:get-arg "-since")))
;; 	   (run-ids    (db:get-changed-run-ids since-time)))
;;       ;; (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
;;       (print (sort run-ids <))
;;       (set! *didsomething* #t)))
      
      

	       (target    (args:get-arg "-target"))
	       (toppath   (assoc/default 'toppath   cmdinfo)))
	  (change-directory toppath)
	  (if (not target)
	      (begin
		(debug:print 0 "ERROR: -target is required.")
		(exit 1)))
	  (if (not (launch:setup))
	      (begin
		(debug:print 0 "Failed to setup, giving up on -test-paths or -test-files, exiting")
		(exit 1)))
	  (let* ((keys     (rmt:get-keys))
		 ;; db:test-get-paths must not be run remote
		 (paths    (tests:test-get-paths-matching keys target (args:get-arg "-test-files"))))
	    (set! *didsomething* #t)

	     (db-host   (assoc/default 'db-host   cmdinfo))
	     (run-id    (assoc/default 'run-id    cmdinfo))
	     (test-id   (assoc/default 'test-id   cmdinfo))
	     (itemdat   (assoc/default 'itemdat   cmdinfo))
	     (work-area (assoc/default 'work-area cmdinfo))
	     (db        #f))
	(change-directory testpath)
	(if (not (launch:setup))
	    (begin
	      (debug:print 0 "Failed to setup, exiting")
	      (exit 1)))
	(if (and state status)
	    (rmt:teststep-set-status! run-id test-id step state status msg logfile)
	    (begin
	      (debug:print 0 "ERROR: You must specify :state and :status with every call to -step")

	       (run-id    (assoc/default 'run-id    cmdinfo))
	       (test-id   (assoc/default 'test-id   cmdinfo))
	       (itemdat   (assoc/default 'itemdat   cmdinfo))
	       (work-area (assoc/default 'work-area cmdinfo))
	       (db        #f) ;; (open-db))
	       (state     (args:get-arg ":state"))
	       (status    (args:get-arg ":status")))
	  (if (not (launch:setup))
	      (begin
		(debug:print 0 "Failed to setup, exiting")
		(exit 1)))

	  (if (args:get-arg "-runstep")(debug:print-info 1 "Running -runstep, first change to directory " work-area))
	  (change-directory work-area)
	  ;; can setup as client for server mode now

;; Various helper commands can go below here
;;======================================================================

(if (or (args:get-arg "-showkeys")
        (args:get-arg "-show-keys"))
    (let ((db #f)
	  (keys #f))
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 "Failed to setup, exiting")
	    (exit 1)))
      (set! keys (rmt:get-keys)) ;;  db))
      (debug:print 1 "Keys: " (string-intersperse keys ", "))
      (if (sqlite3:database? db)(sqlite3:finalize! db))
      (set! *didsomething* #t)))

;;======================================================================
;; Update the database schema, clean up the db
;;======================================================================

(if (args:get-arg "-rebuild-db")
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))
      ;; keep this one local
      (open-run-close patch-db #f)
      (set! *didsomething* #t)))

(if (args:get-arg "-cleanup-db")
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))
      ;; keep this one local
      ;; (open-run-close db:clean-up #f)
      (db:multi-db-sync 
       #f ;; do all run-ids
       ;; 'new2old
       'killservers
       'dejunk
       ;; 'adj-testids
       ;; 'old2new
       'new2old
       )
      (set! *didsomething* #t)))

(if (args:get-arg "-mark-incompletes")
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 "Failed to setup, exiting") b
	    (exit 1)))
      (open-run-close db:find-and-mark-incomplete #f)
      (set! *didsomething* #t)))

;;======================================================================
;; Update the tests meta data from the testconfig files
;;======================================================================

(if (args:get-arg "-update-meta")
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))
      ;; now can find our db
      ;; keep this one local
      (open-run-close runs:update-all-test_meta #f)
      (set! *didsomething* #t)))

;;======================================================================
;; Start a repl
;;======================================================================

;; fakeout readline

(if (or (args:get-arg "-repl")
	(args:get-arg "-load"))
    (let* ((toppath (launch:setup))
	   (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f)))
      (if dbstruct
	  (begin
	    (set! *db* dbstruct)
	    (set! *client-non-blocking-mode* #t)
	    (import extras) ;; might not be needed
	    ;; (import csi)

;; Wait on a run to complete
;;======================================================================

(if (and (args:get-arg "-run-wait")
	 (not (or (args:get-arg "-run")
		  (args:get-arg "-runtests")))) ;; run-wait is built into runtests now
    (begin
      (if (not (launch:setup))
	  (begin
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))
      (operate-on 'run-wait)
      (set! *didsomething* #t)))

;; ;; ;; redo me ;; Not converted to use dbstruct yet

    (begin
      (db:multi-db-sync 
       #f ;; do all run-ids
       'new2old
       )
      (set! *didsomething* #t)))



















;;======================================================================
;; Exit and clean up
;;======================================================================

(if *runremote* (close-all-connections!))

(if (not *didsomething*)

		 0))

(if (args:get-arg "-h")
    (begin
      (print help)
      (exit)))

(if (not (launch:setup))
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

;; (if (args:get-arg "-host")
;;     (begin
;;       (set! *runremote* (string-split (args:get-arg "-host" ":")))

;; This is the *new* methodology. One record to inform them and in the chaos, organise them.
;;
;; NOT YET UTILIZED
;;
(define (runs:create-run-record)
  (let* ((mconfig      (if *configdat*
		           *configdat*
		           (if (launch:setup)
		               *configdat*
		               (begin
		                 (debug:print 0 "ERROR: Called setup in a non-megatest area, exiting")
		                 (exit 1)))))
	  (runrec      (runs:runrec-make-record))
	  (target      (common:args-get-target))
	  (runname     (common:args-get-runname))

      (exit 3))
     ((not runname)
      (debug:print 0 "ERROR: Missing required parameter for " switchname ", you must specify the run name with -runname runname")
      (exit 3))
     (else
      (let (;; (db   #f)
	    (keys #f))
	(if (not (launch:setup))

	    (begin 
	      (debug:print 0 "Failed to setup, exiting")
	      (exit 1)))
	(set! keys (keys:config-get-fields *configdat*))
	;; have enough to process -target or -reqtarg here
	(if (args:get-arg "-reqtarg")
	    (let* ((runconfigf (conc  *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL 

;;
(define (server:ping run-id host:port)
  (let ((tdbdat (tasks:open-db)))
    (let* ((host-port (let ((slst (string-split   host:port ":")))
			(if (eq? (length slst) 2)
			    (list (car slst)(string->number (cadr slst)))
			    #f)))
	   (toppath       (launch:setup))
	   (server-db-dat (if (not host-port)(tasks:get-server (db:delay-if-busy tdbdat) run-id) #f)))
      (if (not run-id)
	  (begin
	    (debug:print 0 "ERROR: must specify run-id when doing ping, -run-id n")
	    (print "ERROR: No run-id")
	    (exit 1))
	  (if (and (not host-port)

htmlviewercmd arora

# -runtests automatically deletes the records for tests with the listed states on starting up a run allowing them to re-run
#     (nb// this is in addition to NOT_STARTED which is automatically re-run)
#
allow-auto-rerun INCOMPLETE ZERO_ITEMS
# could add: STUCK STUCK/DEAD UNKNOWN KILLED KILLREQ PREQ_DISCARD

# Try this
reruns 0

[validvalues]
state start end 0 1 - 2
status pass fail n/a 0 1 running - 2

# These are set before all tests, override them 
# in the testconfig [pre-launch-env-overrides] section