Megatest

(define (common:args-get-state)
  (or (args:get-arg "-state")(args:get-arg ":state")))

(define (common:args-get-status)
  (or (args:get-arg "-status")(args:get-arg ":status")))

(define (common:args-get-testpatt rconf)
  (let* ((rtestpatt     (if rconf (runconfigs-get rconf "TESTPATT") #f))
	 (args-testpatt (or (args:get-arg "-testpatt")
			    (args:get-arg "-runtests")
			    "%"))
	 (testpatt    (or (and (equal? args-testpatt "%")
			       rtestpatt)
			  args-testpatt)))
    (if rtestpatt (debug:print-info 0 "TESTPATT from runconfigs: " rtestpatt))
    testpatt))

(define (common:args-get-runname)
  (or (args:get-arg "-runname")
      (args:get-arg ":runname")))

(define (common:args-get-target #!key (split #f))

	  (with-output-to-port (current-error-port)
	    (lambda ()
	      (print "ERROR: " cmd " returned bad exit code " status)))
	  ""))))

;; Lookup a value in runconfigs based on -reqtarg or -target
(define (runconfigs-get config var)
  (let ((targ (common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET"))))
    (if targ
	(or (configf:lookup config targ var)
	    (configf:lookup config "default" var))
	(configf:lookup config "default" var))))

;; this was inline but I'm pretty sure that is a hold over from when it was *very* simple ...
;;

	  (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 

;; 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")))

;;     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

;;    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 

	(begin
	  (debug:print 2 "Key settings found in runconfig.config:")
	  (for-each (lambda (fullkey)
		      (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0))))
		    sections)
	  (debug:print 2 "---")
	  (set! *already-seen-runconfig-info* #t)))
    ;; finaldat ;; was returning this "finaldat" which would be good but conflicts with other uses
    confdat
    ))

(define (set-run-config-vars run-id keyvals targ-from-db)
  (push-directory *toppath*) ;; the push/pop doesn't appear to do anything ...
  (let ((runconfigf (conc  *toppath* "/runconfigs.config"))
	(targ       (or (common:args-get-target)
			targ-from-db
			(get-environment-variable "MT_TARGET"))))

		               *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))
	  (testpatt    (common:args-get-testpatt #f))





	  (keys        (keys:config-get-fields mconfig))
	  (keyvals     (keys:target->keyval keys target))
	  (toppath     *toppath*)
	  (envdat      keyvals) ;; initial values start with keyvals
	  (runconfig   #f)
	  (serverdat   (if (args:get-arg "-server")
			   *runremote*

	(begin
	  (debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf)
	  (if db (sqlite3:finalize! db))
	  (exit 1)))
    ;; Now have runconfigs data loaded, set environment vars

    ;; Only now can we calculate the testpatt
    (set! testpatt (common:args-get-testpatt runconfig))
    
    (for-each (lambda (section)
		(for-each (lambda (varval)
			    (set! envdat (append envdat (list varval)))
			    (safe-setenv (car varval)(cadr varval)))
			  (configf:get-section runconfig section)))
	      (list "default" target))

					       (exit 4)))))
		       (thread-start! th2)
		       (thread-start! th1)
		       (thread-join! th2)))))
      (set-signal-handler! signal/int sighand)
      (set-signal-handler! signal/term sighand)
      (set-signal-handler! signal/stop sighand))

    (runs:set-megatest-env-vars run-id inkeys: keys inrunname: runname) ;; these may be needed by the launching process
    (set! runconf (if (file-exists? runconfigf)
		      (setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals target)
		      (begin
			(debug:print 0 "WARNING: You do not have a run config file: " runconfigf)
			#f)))

    ;; register this run in monitor.db
    (rmt:tasks-add "run-tests" user target runname test-patts task-key) ;; params)
    (rmt:tasks-set-state-given-param-key task-key "running")

    (if (not test-patts) ;; first time in - adjust testpatt

	(set! test-patts (common:args-get-testpatt runconf)))

    ;; Now generate all the tests lists
    (set! all-tests-registry (tests:get-all))
    (set! all-test-names     (hash-table-keys all-tests-registry))
    (set! test-names         (tests:filter-test-names all-test-names test-patts))

    ;; I think seeding required-tests with all test-names makes sense but lack analysis to back that up.

		     
		     ;; (set! test-names (cons waiton test-names))))) ;; was an append, now a cons
		     )))
	     waitons)
	    (let ((remtests (delete-duplicates (append waitons tal))))
	      (if (not (null? remtests))
		  (begin
		    ;; (debug:print-info 0 "Preprocessing continues for " (string-intersperse remtests ", "))
		    (loop (car remtests)(cdr remtests))))))))

    (if (not (null? required-tests))
	(debug:print-info 1 "Adding \"" (string-intersperse required-tests " ") "\" to the run queue"))
    ;; NOTE: these are all parent tests, items are not expanded yet.
    (debug:print-info 4 "test-records=" (hash-table->alist test-records))
    (let ((reglen (configf:lookup *configdat* "setup" "runqueue")))

SOMEVAR2  This should show up in SOMEVAR4 if the target is ubuntu/nfs/none
VARWITHDOLLARSIGNS The$USER/signs/should/be/replaced/with/variable

[default]
SOMEVAR3 #{rget SOMEVAR}
SOMEVAR4 #{rget SOMEVAR2}
SOMEVAR5 #{runconfigs-get SOMEVAR2}

[ubuntu/nfs/all_toplevel]
TESTPATT all_toplevel

[this/a/test]
BLAHFOO 123

[ubuntu/nfs/sleep1]
SLEEPRUNNER 1

;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;;   License GPL.

(define logbody "LogFileBody")

(define pass-specs '( ;; testname num-expected max-runtime
		     ("exit_0"		        1  20)
		     ("ezlog_fail_then_pass"    1  20)
		     ("ezlog_pass"	        1  20)
		     ("ez_pass"		        1  20)
		     ("lineitem_pass"	        1  20)
		     ("priority_1"	        1  20)
		     ("priority_10"	        1  20)
		     ("priority_10_waiton_1"    1  20)
		     ("priority_3"	        1  20)
		     ("priority_4"	        1  20)
		     ;; ("priority_5"	        1  20)
		     ("priority_6"	        1  20)
;;		     ("priority_7"	        1  20)
		     ("priority_8"	        1  20)
		     ("priority_9"	        1  20)
		     ("runfirst"	        7  20)
		     ("singletest"	        1  20)
		     ("singletest2"	        1  20)
		     ("special"		        1  20)
		     ("sqlitespeed"	       10  20)
		     ("test1"		        1  20)
		     ("test2"		        6  20)
		     ("test_mt_vars"	        6  20)
		     ))

(define fail-specs '( ;; testname num-expected max-runtime
		     ("exit_1"		        1  20)
		     ("ez_exit2_fail"           1  20)
		     ("ez_fail"		        1  20)
		     ("ez_fail_quick"	        1  20)
		     ("ezlog_fail"	        1  20)
		     ("lineitem_fail"	        1  20)
		     ("logpro_required_fail"    1  20)
		     ("manual_example"	        1  20)
		     ("neverrun"	        1  20)))
		     
(define warn-specs   '(("ezlog_warn"	        1  20)))

(define nost-specs   '(("wait_no_items1"        1  20)
		       ("wait_no_items2"        1  20)
		       ("wait_no_items3"        1  20)
		       ("wait_no_items4"        1  20)
		       ;; ("no_items"              1  20)
		       ))

(define (check-one-test estate estatus testname count runtime)
   (let* ((rxe      (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s")))
	  (msg1     (conc testname " expecting count of " count))
	  (msg2     (conc testname " expecting runtime less than " runtime)))
     (expect:required in logbody = count msg1 rxe)
     ;;(expect:value    in logbody count < msg2 rxe)
     ))

;; Special cases
;;
(expect:error    in logbody >  0  "blocktestxz not to run"           #/Test: blocktestxz/)
(expect:ignore   in logbody >= 0  "db_sync test might not have run"  #/Test: db_sync/)
(expect:ignore   in logbody >= 0  "all_toplevel may not yet be done" #/Test: all_toplevel/)
(expect:error    in logbody =  0  "tests left in RUNNING state"      #/State: RUNNING/)
(expect:required in logbody =  1  "priority_2 is KILLED"             #/Test: priority_2\s+State: KILLED\s+Status: KILLED/)
(expect:required in logbody =  1  "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
(expect:required in logbody =  1  "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/)
(expect:required in logbody =  1  "testxz has 1 NOT_STARTED test"    #/Test: testxz\s+State: NOT_STARTED/)
(expect:required in logbody =  1  "no items"                         #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/)
(expect:warning  in logbody =  1  "dynamic waiton"                   #/Test: dynamic_waiton/)
(expect:required in logbody = 29  "blocktestxz has 29 tests"         #/Test: blocktestxz/)

;; General cases
;;
(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "PASS" testdat))
 pass-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "FAIL" testdat))
 fail-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "COMPLETED" "WARN" testdat))
 warn-specs)

(for-each 
 (lambda (testdat)
   (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat))
 nost-specs)

;; Catch all.
;;
(expect:error    in logbody = 0   "Tests not accounted for"     #/Test: /)


;; ;; define your hooks
;; (hook:first-error   "echo \"Error hook activated: #{escaped errmsg}\"")
;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"")
;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"")
;; 
;; ;; first ensure your run at least started
;; ;;
;; (trigger "Init"     #/This is a header/)
;; (trigger "InitEnd"  #/^\s*$/)
;; (section "Init" "Init" "InitEnd")
;; 
;; (trigger "Body"     #/^.*$/) ;; anything starts the body
;; ;; (trigger "EndBody"  #/This had better never match/)
;; 
;; (section "Body"     "Body" "EndBody")
;; 
;; (trigger "Blah2"    #/^begin Blah2/)
;; (trigger "Blah2End" #/^end Blah2/)
;; (section "Blah2"    "Blah2" "Blah2End")
;; 
;; (expect:required in "Init"  = 1 "Header"      #/This is a header/)
;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/)
;; (expect:value    in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/)
;; (expect:value    in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/)
;; (expect:value    in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/)
;; (expect:value    in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/)
;; 
;; ;; Using match number
;; (expect:value    in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; ;; Comparison instead of tolerance
;; (expect:value    in "LogFileBody" 1.9 >   "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2)
;; 
;; (expect:ignore   in "Blah2" < 99 "FALSE ERROR" #/ERROR/)
;; (expect:ignore   in "Body"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
;; (expect:warning  in "Body"  = 0 "Any warning" #/WARNING/)
;; (expect:error    in "Body"  = 0 "ERROR BLAH"  (list #/ERROR/ #/error/)) ;; but disallow any other errors
;; 
;; ;(expect in "Init"  < 1 "Junk"        #/This is bogus/)

[var]
targ -target ubuntu/nfs/all_toplevel
tp   -testpatt %

[ezsteps]
cleantop $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -remove-runs #{get var tp}  #{get var targ} -runname release_toplevel
runall   $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run         #{get var tp}  #{get var targ} -runname release_toplevel -runwait
results  $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs release_toplevel #{get var targ} -runname release_toplevel 

[requirements]
# waiton  #{getenv ALL_TOPLEVEL_TESTS}

# This is a "toplevel" test, it does not require waitons to be non-FAIL to run
# mode toplevel