Megatest

    (set! open-run-close open-run-close-no-exception-handling))

(if (args:get-arg "-itempatt")
    (let ((newval (conc (args:get-arg "-testpatt") "/" (args:get-arg "-itempatt"))))
      (debug:print 0 "WARNING: -itempatt has been deprecated, please use -testpatt testpatt/itempatt method, new testpatt is "newval)
      (hash-table-set! args:arg-hash "-testpatt" newval)
      (hash-table-delete! args:arg-hash "-itempatt")))



(on-exit std-exit-procedure)

;;======================================================================
;; Misc general calls
;;======================================================================

      (if (not (car *configinfo*))
	  (begin
	    (debug:print 0 "ERROR: Attempted " action "on test(s) but run area config file not found")
	    (exit 1))
	  ;; put test parameters into convenient variables
	  (runs:operate-on  action
			    target
			    (common:args-get-runname)  ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
			    (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
			    state: (common:args-get-state)
			    status: (common:args-get-status)
			    new-state-status: (args:get-arg "-set-state-status")))
      (set! *didsomething* #t)))))
	  
(if (args:get-arg "-remove-runs")
    (general-run-call 
     "-remove-runs"
     "remove runs"

;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
(if (or (args:get-arg "-list-runs")
	(args:get-arg "-list-db-targets"))
    (if (launch:setup-for-run)
	(let* ((dbstruct    (make-dbr:dbstruct path: *toppath* local: #t))
	       (runpatt     (args:get-arg "-list-runs"))
	       (testpatt    (common:args-get-testpatt #f))
	       ;; (if (args:get-arg "-testpatt") 
	       ;;  	        (args:get-arg "-testpatt") 
	       ;;  	        "%"))
	       (keys        (db:get-keys dbstruct))
	       ;; (runsda   t  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat     (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
			           	 #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment")))
	       (runstmp     (db:get-rows runsdat))
	       (header      (db:get-header runsdat))
	       (runs        (if (and (not (null? runstmp))

;;     launch task
;;   else
;;     put task in deferred queue
;; if still ok to run tasks
;;   process deferred tasks per above steps

;; run all tests are are Not COMPLETED and PASS or CHECK
(if (or (args:get-arg "-runall")
	(args:get-arg "-run")
	(args:get-arg "-runtests"))
    (general-run-call 
     "-runall"
     "run all tests"
     (lambda (target runname keys keyvals)
       (runs:run-tests target
		       runname
		       #f ;; (common:args-get-testpatt #f)
		       ;; (or (args:get-arg "-testpatt")
		       ;;     "%")
		       user
		       args:arg-hash))))

;;======================================================================
;; run one test
;;======================================================================

;; 1. find the config file
;; 2. change to the test directory
;; 3. update the db with "test started" status, set running host
;; 4. process launch the test
;;    - monitor the process, update stats in the db every 2^n minutes
;; 5. as the test proceeds internally it calls megatest as each step is
;;    started and completed
;;    - step started, timestamp
;;    - step completed, exit status, timestamp
;; 6. test phone home
;;    - if test run time > allowed run time then kill job
;;    - if cannot access db > allowed disconnect time then kill job

;; == duplicated == (if (or (args:get-arg "-run")(args:get-arg "-runtests"))
;; == duplicated ==   (general-run-call 
;; == duplicated ==    "-runtests" 
;; == duplicated ==    "run a test" 
;; == duplicated ==    (lambda (target runname keys keyvals)
;; == duplicated ==      ;;
;; == duplicated ==      ;; May or may not implement it this way ...
;; == duplicated ==      ;;
;; == duplicated ==      ;; Insert this run into the tasks queue
;; == duplicated ==      ;; (open-run-close tasks:add tasks:open-db 
;; == duplicated ==      ;;    	     "runtests" 
;; == duplicated ==      ;;    	     user
;; == duplicated ==      ;;    	     target
;; == duplicated ==      ;;    	     runname
;; == duplicated ==      ;;    	     (args:get-arg "-runtests")
;; == duplicated ==      ;;    	     #f))))
;; == duplicated ==      (runs:run-tests target
;; == duplicated == 		     runname
;; == duplicated == 		     (common:args-get-testpatt #f) ;; (args:get-arg "-runtests")
;; == duplicated == 		     user
;; == duplicated == 		     args:arg-hash))))

;;======================================================================
;; Rollup into a run
;;======================================================================

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

      (set! *didsomething* #t)))

;;======================================================================
;; 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-for-run))
	  (begin
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))
      (operate-on 'run-wait)
      (set! *didsomething* #t)))

(if (not *didsomething*)
    (debug:print 0 help))

(set! *time-to-exit* #t)
(thread-join! *watchdog*)

(if (not (eq? *globalexitstatus* 0))
    (if (or (args:get-arg "-run")(args:get-arg "-runtests")(args:get-arg "-runall"))
        (begin
           (debug:print 0 "NOTE: Subprocesses with non-zero exit code detected: " *globalexitstatus*)
           (exit 0))
        (case *globalexitstatus*
         ((0)(exit 0))
         ((1)(exit 1))
         ((2)(exit 2))
         (else (exit 3)))))