Megatest

tests/installall/megatest.db
tests/installall/monitor.db
tests/megatest.db
tests/fdktestqa/simplelinks/*
tests/fdktestqa/testqa/megatest.db
tests/fdktestqa/testqa/monitor.db
megatest-fossil-hash.scm
tests/release/runs/*
tests/release/links/*
tests/release/megatest.db

    get-run-status
    register-run
    get-tests-for-run
    get-test-id
    get-tests-for-runs-mindata
    get-run-name-from-id
    get-runs
    get-num-runs
    get-all-run-ids
    get-prev-run-ids
    get-run-ids-matching-target
    get-runs-by-patt
    get-steps-data
    get-steps-for-test
    login

	    ;;======================================================================
	    ;; READ ONLY QUERIES
	    ;;======================================================================

	    ;; KEYS
	    ((get-key-val-pairs)               (apply db:get-key-val-pairs dbstruct area-dat params))
	    ((get-keys)                        (db:get-keys dbstruct area-dat))
	    ((get-key-vals)                    (apply db:get-key-vals dbstruct params))
	    ((get-targets)                     (db:get-targets  dbstruct))

	    ;; ARCHIVES
	    ((test-get-archive-block-info)     (apply db:test-get-archive-block-info dbstruct area-dat params))
	    
	    ;; TESTS
	    ((test-toplevel-num-items)         (apply db:test-toplevel-num-items dbstruct area-dat params))
	    ((get-test-info-by-id)	       (apply db:get-test-info-by-id dbstruct area-dat params))

	    ((get-run-status)               (apply db:get-run-status dbstruct area-dat params))
	    ((set-run-status)               (apply db:set-run-status dbstruct area-dat params))
	    ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct area-dat params))
	    ((get-test-id)                  (apply db:get-test-id dbstruct area-dat params))
	    ((get-tests-for-run-mindata)    (apply db:get-tests-for-run-mindata dbstruct area-dat params))
	    ((get-runs)                     (apply db:get-runs dbstruct area-dat params))
	    ((get-all-run-ids)              (db:get-all-run-ids dbstruct area-dat))
	    ((get-num-runs)                 (apply db:get-num-runs dbstruct params))
	    ((get-prev-run-ids)             (apply db:get-prev-run-ids dbstruct area-dat params))
	    ((get-run-ids-matching-target)  (apply db:get-run-ids-matching-target dbstruct area-dat params))
	    ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct area-dat params))
	    ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct area-dat params))

	    ;; STEPS
	    ((get-steps-data)               (apply db:get-steps-data dbstruct area-dat params))

#!/bin/bash 

if [[ $SLEEPRUNNER == "" ]];then
SLEEPRUNNER=1
SLEEPRUNNER=0
fi
  
echo "nbfake $@ &> /dev/null" | at now + $SLEEPRUNNER minutes &> /dev/null

   "disks" '("none" "")))

;;======================================================================
;; T A R G E T S
;;======================================================================

(define (common:args-get-target #!key (split #f))
  (let* ((keys    (keys:config-get-fields *configdat*))
	 (numkeys (length keys))
  (let* ((target  (if (args:get-arg "-reqtarg")
	 (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) '()))
	 (valid   (if target
		      (and (not (null? tlist))
			   (eq? numkeys (length tlist))
			   (null? (filter string-null? tlist)))
		      #f)))
    (if valid
	(if split
	    tlist
	    target)
	(if target
	    (begin
	      (debug:print 0 "ERROR: Invalid target, spaces or blanks not allowed \"" target "\"")
	      (debug:print 0 "ERROR: Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/"))
	      #f)
	    #f))))

;;======================================================================
;; M I S C   L I S T S
;;======================================================================

			 (iup:label "TestComment                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)
			   (let ((newcomment (db:test-get-comment testdat)))
			     (if *dashboard-comment-share-slot*
				 (if (not (equal? (iup:attribute *dashboard-comment-share-slot* "VALUE")
						  newcomment))
				     (iup:attribute-set! *dashboard-comment-slot*
				     (iup:attribute-set! *dashboard-comment-share-slot*
							 "VALUE"
							 newcomment)))
			     newcomment)))
	    (store-label "testid"
			 (iup:label "TestId                             "
				    #:expand "HORIZONTAL")
			 (lambda (testdat)

	  (exit 1))
	(let* (;; (run-id        (if testdat (db:test-get-run_id testdat) #f))
	       (keydat        (if testdat (db:get-key-val-pairs dbstruct run-id) #f))
	       (rundat        (if testdat (db:get-run-info dbstruct run-id) #f))
	       (runname       (if testdat (db:get-value-by-header (db:get-rows rundat)
								  (db:get-header rundat)
								  "runname") #f))
	       (tdb           (tdb:open-test-db-by-test-id-local dbstruct area-dat run-id test-id))
	       ;; (tdb           (tdb:open-test-db-by-test-id-local dbstruct area-dat run-id test-id))
	       ;; These next two are intentional bad values to ensure errors if they should not
	       ;; get filled in properly.
	       (logfile       "/this/dir/better/not/exist")
	       (rundir        (if testdat 
				  (db:test-get-rundir testdat)
				  logfile))
	       (testdat-path  (conc rundir "/testdat.db")) ;; this gets recalculated until found 
	       ;; (testdat-path  (conc rundir "/testdat.db")) ;; this gets recalculated until found 
	       (teststeps     (if testdat (tests:get-compressed-steps dbstruct run-id test-id) '()))
	       (testfullname  (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
	       (testname      (if testdat (db:test-get-testname testdat) "n/a"))
	       (testmeta      (if testdat 
				  (let ((tm (db:testmeta-get-record dbstruct testname)))
				    (if tm tm (make-db:testmeta)))
				  (make-db:testmeta)))

						  (conc "-e " (get-environment-variable "SHELL"))
						  "")))
				   (system (conc "cd " rundir 
						 ";mt_xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")))
				 (message-window  (conc "Directory " rundir " not found")))))
	       (widgets    (make-hash-table))
	       (refreshdat (lambda ()
			     (let* ((curr-mod-time (max (file-modification-time db-path)
							(if (file-exists? testdat-path)
							    (file-modification-time testdat-path)
							    (begin
							      (set! testdat-path (conc rundir "/testdat.db"))
							      0))))
			     (let* ((curr-mod-time (file-modification-time db-path))
				                   ;;     (max ..... (if (file-exists? testdat-path)
						   ;;      	      (file-modification-time testdat-path)
						   ;;      	      (begin
						   ;;      		(set! testdat-path (conc rundir "/testdat.db"))
						   ;;      		0))))
				    (need-update   (or (and (>= curr-mod-time db-mod-time)
							    (> (current-milliseconds)(+ last-update 250))) ;; every half seconds if db touched
						       (> (current-milliseconds)(+ last-update 10000))     ;; force update even 10 seconds
						       request-update))
				    (newtestdat (if need-update 
						    ;; NOTE: BUG HIDER, try to eliminate this exception handler
						    (handle-exceptions

											      (db:test-data-get-value    x)
											      (db:test-data-get-expected x)
											      (db:test-data-get-tol      x)
											      (db:test-data-get-status   x)
											      (db:test-data-get-units    x)
											      (db:test-data-get-type     x)
											      (db:test-data-get-comment  x)))
										    (tdb:open-run-close-db-by-test-id-local dbstruct area-dat run-id test-id #f tdb:read-test-data test-id "%")))
										    ;; (tdb:open-run-close-db-by-test-id-local dbstruct area-dat run-id test-id #f tdb:read-test-data test-id "%")))
										    (db:read-test-data dbstruct area-dat run-id test-id "%")))
									      "\n")))
							       (if (not (equal? currval newval))
								   (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval)))))
					  test-data))
				       ;;(dashboard:run-controls)
				       )))
				 (iup:attribute-set! tabs "TABTITLE0" "Steps")

      (exit)))

;; (if (args:get-arg "-host")
;;     (begin
;;       (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":")))
;;       (client:launch))
;;     (client:launch))
(define *useserver* (or (args:get-arg "-use-server")
			(configf:lookup *configdat* "dashboard" "use-server")))

(define *keys*   (if *useserver*
		     (rmt:get-keys)
		     (db:get-keys *dbstruct-local*)))
(define *tot-run-count* (if *useserver*
			    (rmt:get-num-runs "%")
			    (db:get-num-runs *dbstruct-local* "%")))


;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define *runremote* #f)

			(iup:attribute-set! lb "VALUE" item))) ;; (number->string i))))
		(set! i (+ i 1)))
	      items)
    i))

(define (pad-list l n)(append l (make-list (- n (length l)))))

	 (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)))
		       (tests       (if *useserver*
					(rmt:get-tests-for-run run-id testnamepatt states statuses
							       #f #f
							       *hide-not-hide*
							       sort-by
							       sort-order
							       'shortlist)
					(db:get-tests-for-run *dbstruct-local* run-id testnamepatt states statuses
							      #f #f
							      *hide-not-hide*
							      sort-by
							      sort-order
							      'shortlist)))
		       (key-vals    (if *useserver* 
					(rmt:get-key-vals run-id)
					(db:get-key-vals *dbstruct-local* run-id))))

(define (mkstr . x)
  (string-intersperse (map conc x) ","))

(define (update-search x val)
  (hash-table-set! *searchpatts* x val))


;;======================================================================
;; T E S T S
;;======================================================================

	 (db-target-dat (if *useserver* 
			    (rmt:get-targets)
			    (db:get-targets *dbstruct-local*)))

;; Test browser
(define (dashboard:tree-browser data adat window-id)
  ;; (iup:split
  (let* ((tb      (iup:treebox
		   #:selection-cb
		   (lambda (obj id state)

;;======================================================================

;; General displayer
;;
(define (dashboard:area-display data adat window-id)
  (let* ((view-matrix     (iup:matrix
			   ;; (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f))
					    (runs-for-targ (if *useserver*
							       (rmt:get-runs-by-patt *keys* "%" target #f #f #f)
							       (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f)))
			   #:expand "YES"
			   ;; #:fittosize "YES"
			   #:scrollbar "YES"
			   #:numcol 100
			   #:numlin 100
			   #:numcol-visible 3
			   #:numlin-visible 3

;; NB// Wierd conflict error here
;;
;;		     (let* ((runs-dat     (db:get-runs-by-patt db *keys* "%" #f #f #f #f))

;;======================================================================
;; A R E A S
;;======================================================================
		       (if (number? run-id)
			     (dashboard:update-run-summary-tab))
			   (debug:print 0 "ERROR: tree-path->run-id returned non-number " run-id)))
		       )))

(define (dashboard:init-area data area-name apath)
  (let* ((mtconffile  (conc area-name "/megatest.config"))
	 (mtconf      (read-config mtconffile (make-hash-table) #f)) ;; megatest.config
	 (area-dat    (let ((ad (make-megatest:area
			       area-name ;; area name
			       apath     ;; path to area

	 ;; (states   '())
	 ;; (statuses '())
	 (nextmintime (current-milliseconds)))
    (dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data)))
    ;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
    (iup:show (dashboard:main-panel data (dboard:data-current-window-id data)))
    ;; Yes, running iup:show will pop up a new panel
    ;; (iup:show (main-panel my-window-id))
  (let* ((dat     (let ((d (map string->number (string-split (args:get-arg "-test") ","))))
		    (if (> (length d) 1)
			d
			(list #f #f))))
    (iup:callback-set! *tim*
		       "ACTION_CB"
		       (lambda (x)
			 (let ((starttime (current-milliseconds)))
			   ;; Want to dedicate no more than 50% of the time to this so skip if
			   ;; 2x delta time has not passed since last query
			   ;; (if (< (inexact->exact nextmintime)(inexact->exact starttime))

    ;; Now do rollups for the toplevel tests
    ;;
    (db:delay-if-busy dbdat area-dat)
    (for-each
     (lambda (toptest)
       (let ((test-name (list-ref toptest 3)))
;;	     (run-id    (list-ref toptest 5)))
	  (db:general-call db 'top-test-set-per-pf-counts (list test-name run-id test-name test-name test-name)))) ;; (list run-id test-name))))
	 (db:top-test-set-per-pf-counts db run-id test-name)))
     toplevels)))

(define (db:top-test-set-per-pf-counts db run-id test-name)
  (db:general-call db 'top-test-set-per-pf-counts (list test-name test-name run-id test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name))) 
 
		     
;; Clean out old junk and vacuum the database
;;
;; Ultimately do something like this:
;;
;; 1. Look at test records either deleted or part of deleted run:
;;    a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown'

			 (else (conc "ERROR: bad tol comparator " tol))))))
	 (debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	 (db:delay-if-busy dbdat area-dat)
	 (sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status,type) VALUES (?,?,?,?,?,?,?,?,?,?);"
			  test-id category variable value expected tol units (if comment comment "") status type)))
     csvlist)))

;; This routine moved from tdb.scm, tdb:read-test-data
;;
(define (db:read-test-data dbstruct run-id test-id categorypatt)
  (let* ((dbdat      (db:get-db dbstruct run-id))
	 (db         (db:dbdat-get-db dbdat))
	 (res '()))
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (lambda (id test_id category variable value expected tol units comment status type)
       (set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
     db
     "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
    (reverse res)))

;;======================================================================
;; Misc. test related queries
;;======================================================================

(define (db:get-run-ids-matching-target dbstruct area-dat keynames target res runname testpatt statepatt statuspatt)
  (let* ((dbdat    (db:get-db dbstruct area-dat #f))

  (let ((dbdat  (db:get-db dbstruct area-dat run-id)))
    (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
	(db:general-call dbdat 'set-test-start-time (list test-id)))
    (if msg
	(db:general-call dbdat 'state-status-msg (list state status msg test-id))
	(db:general-call dbdat 'state-status     (list state status test-id)))))

(define (db:roll-up-pass-fail-counts dbstruct area-dat run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
;; (define (db:roll-up-pass-fail-counts dbstruct area-dat run-id test-name item-path status)
(define (db:roll-up-pass-fail-counts dbstruct area-dat run-id test-name item-path state status)
  (if ;; (and
      (not (equal? item-path ""))
	   (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP" "LAUNCHED")))
      (let ((dbdat (db:get-db dbstruct area-dat run-id)))
   ;; (not (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP" "LAUNCHED")))
	(db:general-call dbdat 'update-pass-fail-counts (list test-name test-name test-name))
	(if (equal? status "RUNNING")
	    (db:general-call dbdat 'top-test-set-running (list test-name))
	;; NOTE: No else clause needed for this case
	(case (string->symbol status)
	 ((RUNNING)  (db:general-call dbdat 'top-test-set-running (list test-name)))
	    (if (equal? status "LAUNCHED")
		(db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name))
		(db:general-call dbdat 'top-test-set-per-pf-counts (list test-name run-id test-name test-name test-name))))
	 ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name)))
	 ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name))))
	(let ((db (db:dbdat-get-db dbdat)))
	  (db:top-test-set-per-pf-counts db run-id test-name))
	#f)
      ;; if the test is not COMPLETED then this routine should not have been called
      (begin
	(debug:print 0 "ERROR: db:test-set-state-status called with state " state " and status " status)
      #f))
	#f)))

(define (db:test-get-logfile-info dbstruct area-dat run-id test-name)
  (db:with-db
   dbstruct area-dat
   run-id
   #f
   (lambda (db)

	'(tests:test-set-toplog   "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
	'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;") ;; DONE
	'(update-uname-host       "UPDATE tests SET uname=?,host=? WHERE id=?;")       ;; DONE
	'(update-test-state       "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	'(update-test-status      "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	;; stuff for roll-up-pass-fail-counts
	'(update-pass-fail-counts "UPDATE tests 
             SET fail_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('FAIL','CHECK')),
             SET fail_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('FAIL','CHECK','INCOMPLETE','ABORT')),
                 pass_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED'))
             WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set          "UPDATE tests SET state=? WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set-running  "UPDATE tests SET state='RUNNING' WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set-per-pf-counts "UPDATE tests
                       SET state=CASE 
                                   WHEN (SELECT count(id) FROM tests 
                                                WHERE testname=?
                                                     AND item_path != '' 
                                                     AND status IN ('INCOMPLETE')
                                                     AND state in ('RUNNING','NOT_STARTED','LAUNCHED','REMOTEHOSTSTART')) > 0 THEN 'INCOMPLETE'
                                   WHEN (SELECT count(id) FROM tests 
                                                WHERE testname=?
                                                     AND item_path != '' 
                                                     AND status NOT IN ('TEN_STRIKES','BLOCKED')
                                                     AND state in ('RUNNING','NOT_STARTED','LAUNCHED','REMOTEHOSTSTART')) > 0 THEN 'RUNNING'
                                   ELSE 'COMPLETED' END,
                            status=CASE 
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE run_id=? AND testname=?
                                              AND item_path != ''
                                              AND state IN ('NOT_STARTED','BLOCKED')) > 0 THEN 'FAIL'
                                  WHEN fail_count > 0 THEN 'FAIL' 
                                  WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' 
                                              AND state IN ('NOT_STARTED','BLOCKED','INCOMPLETE')) > 0 THEN 'FAIL'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status = 'ABORT') > 0 THEN 'ABORT'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status = 'AUTO') > 0 THEN 'AUTO'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status IN ('STUCK/INCOMPLETE', 'INCOMPLETE')) > 0 THEN 'INCOMPLETE'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status = 'CHECK') > 0 THEN 'CHECK'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status = 'SKIP') > 0 THEN 'SKIP'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status = 'WARN') > 0 THEN 'WARN'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status = 'WAIVED') > 0 THEN 'WAIVED'
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=? 
                                              AND item_path != ''
                                              AND state NOT IN ('DELETED')
                                              AND status NOT IN ('PASS','FAIL','WARN','WAIVED')) > 0 THEN 'ABORT'
                                  WHEN fail_count > 0 THEN 'FAIL' 
                                  WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' 
                                  ELSE 'UNKNOWN' END
                       WHERE testname=? AND item_path='';") ;; DONE

	;; STEPS
	'(delete-test-step-records "UPDATE test_steps SET status='DELETED' WHERE test_id=?;")
	'(delete-test-data-records "UPDATE test_data  SET status='DELETED' WHERE test_id=?;") ;; using status since no state field
	))

;;    if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met
;;
;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED)
;;       mode 'toplevel means that tests must be COMPLETED only
;;       mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]]
;; 
;; (define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path mode)
(define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f))
;; (define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f))
(define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path mode itemmap) ;; #!key (mode '(normal))(itemmap #f))
  (if (or (not waitons)
	  (null? waitons))
      '()
      (let* ((unmet-pre-reqs '())
	     (result         '()))
	(for-each 
	 (lambda (waitontest-name)

				 ;; Since we should have a clean slate at this time there is no need to do 
				 ;; any of the other stuff that tests:test-set-status! does. Let's just 
				 ;; force RUNNING/n/a
				 

				 ;; (thread-sleep! 0.3)
				 (tests:test-force-state-status! run-id test-id "RUNNING" "n/a")
;; 				 (rmt:roll-up-pass-fail-counts run-id test-name item-path "RUNNING" area-dat)
				 (rmt:roll-up-pass-fail-counts run-id test-name item-path "RUNNING" area-dat)
				 (rmt:roll-up-pass-fail-counts run-id test-name item-path #f "RUNNING" area-dat)
				 ;; (thread-sleep! 0.3) ;; NFS slowness has caused grief here

				 ;; if there is a runscript do it first
				 (if fullrunscript
				     (let ((pid (process-run fullrunscript)))
				       (rmt:test-set-top-process-pid run-id test-id pid area-dat)
				       (let loop ((i 0))

	(begin
	  (debug:print-info 0 "attempting to preclean directory " (db:test-get-rundir testinfo) " for test " test-name "/" item-path)
	  (runs:remove-test-directory testinfo 'remove-data-only))) ;; remove data only, do not perturb the record
    
    ;; prevent overlapping actions - set to LAUNCHED as early as possible
    ;;
    (tests:test-set-status! run-id test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED"))
;;    (rmt:roll-up-pass-fail-counts run-id test-name item-path "LAUNCHED" area-dat)
    (rmt:roll-up-pass-fail-counts run-id test-name item-path "LAUNCHED" area-dat)
    (rmt:roll-up-pass-fail-counts run-id test-name item-path #f "LAUNCHED" area-dat)
    (set! diskpath (get-best-disk configdat))
    (if diskpath
	(let ((dat  (create-work-area run-id run-info keyvals test-id test-path diskpath test-name itemdat)))
	  (set! work-area (car dat))
	  (set! toptest-work-area (cadr dat))
	  (debug:print-info 2 "Using work area " work-area))
	(begin

;; Always use two or four digit decimal
;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.6015)
(define megatest-version 1.6017)

;; Copyright 2006-2012, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

;; (include "common.scm")
;; (include "megatest-version.scm")

(define (toplevel-command . a) #f)

(define (toplevel-command . a) #f)

;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 readline apropos json http-client directory-utils rpc ;; (srfi 18) extras)
     http-client srfi-18 extras format) ;;  zmq extras)

  license GPL, Copyright Matt Welland 2006-2015

Usage: megatest [options]
  -h                      : this help
  -version                : print megatest version (currently " megatest-version ")

Launching and managing runs
  -runall                 : run all tests that are not state COMPLETED and status PASS, 
  -runall                 : run all tests or as specified by -testpatt
                            CHECK or KILLED
  -runtests tst1,tst2 ... : run tests
  -remove-runs            : remove the data for a run, requires -runname and -testpatt
                            Optionally use :state and :status
  -set-state-status X,Y   : set state to X and status to Y, requires controls per -remove-runs
  -rerun FAIL,WARN...     : force re-run for tests with specificed status(s)
  -lock                   : lock run specified by target and runname
  -unlock                 : unlock run specified by target and runname
  -set-run-status status  : sets status for run to status, requires -target and -runname

			"-show-config"
			"-show-cmdinfo"
			"-get-run-status"

			;; queries
			"-test-paths" ;; get path(s) to a test, ordered by youngest first

			"-runall"    ;; run all tests
			"-runall"    ;; run all tests, respects -testpatt
			"-run"       ;; alias for -runall
			"-remove-runs"
			"-rebuild-db"
			"-cleanup-db"
			"-rollup"
			"-update-meta"
			"-gen-megatest-area"
			"-mark-incompletes"

	(args:get-arg "-get-run-status"))
    (general-run-call
     "-set-run-status"
     "set run status"
     (lambda (target runname keys keyvals)
       (let* ((runsdat  (rmt:get-runs-by-patt keys runname 
					(common:args-get-target)
					#f #f))
					#f #f #f))
	      (header   (vector-ref runsdat 0))
	      (rows     (vector-ref runsdat 1)))
	 (if (null? rows)
	     (begin
	       (debug:print-info 0 "No matching run found.")
	       (exit 1))
	     (let* ((row      (car (vector-ref runsdat 1)))

	(let* ((dbstruct (make-dbr:dbstruct path: (megatest:area-path *area-dat*) local: #t))
	       (runpatt     (args:get-arg "-list-runs"))
	       (testpatt    (if (args:get-arg "-testpatt") 
			        (args:get-arg "-testpatt") 
			        "%"))
	       (keys        (db:get-keys dbstruct))
	       ;; (runsda   t  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat     (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target)
	       (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))
				     (args:get-arg "-since"))
				(let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since")))))
				  (let loop ((hed (car runstmp))

	       (db-targets  (args:get-arg "-list-db-targets"))
	       (seen        (make-hash-table))
	       (dmode       (let ((d (args:get-arg "-dumpmode")))
			      (if d (string->symbol d) #f)))
	       (data        (make-hash-table))
	       (fields-spec (if (args:get-arg "-fields")
				(extract-fields-constraints (args:get-arg "-fields"))
				(list (list "runs"  "id" "target"   "runname")
				(list (cons "runs" (append keys (list "id" "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count")))
				      (cons "tests"  db:test-record-fields) ;; "id" "testname" "test_path")
				      (list "steps" "id" "stepname"))))
	       (runs-spec   (let ((r (alist-ref "runs"  fields-spec equal?)))
			      (if (and r (not (null? r))) r (list "id"))))
	       (runs-spec   (let ((r (alist-ref "runs"  fields-spec equal?))) ;; the check is now unnecessary
			      (if (and r (not (null? r))) r (list "id" ))))
	       (tests-spec  (let ((t (alist-ref "tests" fields-spec equal?)))
			      (if (and t (null? t)) ;; all fields
				  db:test-record-fields
				  t)))
	       (adj-tests-spec (delete-duplicates (if tests-spec (cons "id" tests-spec) db:test-record-fields))) ;; '("id"))))
	       (steps-spec  (alist-ref "steps" fields-spec equal?))
	       (test-field-index (make-hash-table)))

							 (db:get-value-by-header run header x))
						       keys) "/")))
	       (if db-targets
		   (if (not (hash-table-ref/default seen targetstr #f))
		       (begin
			 (hash-table-set! seen targetstr #t)
			 ;; (print "[" targetstr "]"))))
			 (if (not dmode)(print targetstr))))
			 (if (not dmode)
			     (print targetstr)
			     (hash-table-set! data "targets" (cons targetstr (hash-table-ref/default data "targets" '())))
			     )))
		   (let* ((run-id  (db:get-value-by-header run header "id"))
			  (runname (db:get-value-by-header run header "runname")) 
			  (tests   (if tests-spec
				       (rmt:get-tests-for-run run-id testpatt '() '() #f #f #f 'testname 'asc 
				       (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc 
							     ;; use qryvals if test-spec provided
							     (if tests-spec
								 (string-intersperse adj-tests-spec ",")
								 ;; db:test-record-fields
								 #f))
				       '())))
		     (case dmode

;;     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 (args:get-arg "-runall")
(if (or (args:get-arg "-runall")(args:get-arg "-run"))
    (general-run-call 
     "-runall"
     "run all tests"
     (lambda (target runname keys keyvals)
       (runs:run-tests target
		       runname
		       (args:get-arg "-testpatt")

;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

(use format numbers)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)

(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))

(declare (uses margs))
(declare (uses launch))
(declare (uses megatest-version))
(declare (uses gutils))
(declare (uses db))
(declare (uses server))
(declare (uses synchash))
(declare (uses dcommon))
(declare (uses tree))
(declare (uses configf))

(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")

(define help (conc 
	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "
  license GPL, Copyright (C) Matt Welland 2011

Usage: dashboard [options]
  -h                : this help
  -group groupname  : display this group of areas
  -test testid      : control test identified by testid
  -guimonitor       : control panel for runs

Misc
  -rows N         : set number of rows
"))

;; process args
(define remargs (args:get-args 
		 (argv)
		 (list  "-group" ;; display this group of areas
			"-debug"
			) 
		 (list  "-h"
			"-v"
			"-q"
			)
		 args:arg-hash
		 0))

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

;; (if (args:get-arg "-host")
;;     (begin
;;       (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":")))
;;       (client:launch))
;;     (client:launch))

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define *runremote* #f)

(debug:setup)

(define *tim* (iup:timer))
(define *ord* #f)

(iup:attribute-set! *tim* "TIME" 300)
(iup:attribute-set! *tim* "RUN" "YES")

(define (message-window msg)
  (iup:show
   (iup:dialog
    (iup:vbox 
     (iup:label msg #:margin "40x40")))))

(define (iuplistbox-fill-list lb items . default)
  (let ((i 1)
	(selected-item (if (null? default) #f (car default))))
    (iup:attribute-set! lb "VALUE" (if selected-item selected-item ""))
    (for-each (lambda (item)
		(iup:attribute-set! lb (number->string i) item)
		(if selected-item
		    (if (equal? selected-item item)
			(iup:attribute-set! lb "VALUE" item))) ;; (number->string i))))
		(set! i (+ i 1)))
	      items)
    i))

(define (pad-list l n)(append l (make-list (- n (length l)))))


(define (mkstr . x)
  (string-intersperse (map conc x) ","))

(define (update-search x val)
  (hash-table-set! *searchpatts* x val))


;;======================================================================
;; T E S T S
;;======================================================================


;; Test browser
(define (dashboard:tree-browser data adat window-id)
  ;; (iup:split
  (let* ((tb      (iup:treebox
		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((tree-path (tree:node->path obj id))
			    (area      (car tree-path))
			    (area-path (cdr tree-path)))
		       #f
		       ;; (test-id  (tree-path->test-id (cdr run-path))))
		       ;; (if test-id
		       ;;    (hash-table-set! (dboard:data-get-curr-test-ids *data*)
		       ;;		     window-id test-id))
		       ;; (print "path: " (tree:node->path obj id) " test-id: " test-id))))))
		       )))))
    ;; (iup:attribute-set! tb "VALUE" "0")
    ;; (iup:attribute-set! tb "NAME" "Runs")
    ;; (iup:attribute-set! tb "ADDEXPANDED" "NO")
    ;; (dboard:data-set-tests-tree! *data* tb)
    tb))
;;   (test-panel window-id)))

;; The function to update the fields in the test view panel
(define (test-update window-id testdat run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix steps-matrix data-matrix)
  ;; get test-id
  ;; then get test record
  (if testdat
      (let* ((test-id      (hash-table-ref/default (dboard:data-get-curr-test-ids *data*) window-id #f))
	     (test-data    (hash-table-ref/default testdat test-id #f))
	     (run-id       (db:test-get-run_id test-data))
	     (targ/runname (hash-table-ref/default (dboard:data-get-run-keys *data*) 
						   run-id
						   '()))
	     (target       (if (null? targ/runname) "" (string-intersperse (reverse (cdr (reverse targ/runname))) "/")))
	     (runname      (if (null? targ/runname) "" (car (cdr targ/runname))))
	     (steps-dat    (tests:get-compressed-steps *dbstruct-local* run-id test-id)))
	
	(if test-data
	    (begin
	      ;; 
	      (for-each 
	       (lambda (data)
		 (let ((mat    (car data))
		       (vals   (cadr data))
		       (rownum 1))
		   (for-each 
		    (lambda (key)
		      (let ((cell   (conc rownum ":1")))
			(if (not (equal? (iup:attribute mat cell)(conc key)))
			    (begin
			      ;; (print "setting cell " cell " in matrix " mat " to value " key)
			      (iup:attribute-set! mat cell (conc key))
			      (iup:attribute-set! mat "REDRAW" cell)))
			(set! rownum (+ rownum 1))))
		    vals)))
	       (list 
		(list run-info-matrix
		      (if test-id
			  (list (db:test-get-run_id test-data)
				target
				runname
				"n/a")
			  (make-list 4 "")))
		(list test-info-matrix
		      (if test-id
			  (list test-id
				(db:test-get-testname test-data)
				(db:test-get-item-path test-data)
				(db:test-get-state    test-data)
				(db:test-get-status   test-data)
				(seconds->string (db:test-get-event_time test-data))
				(db:test-get-comment  test-data))
			  (make-list 7 "")))
		(list test-run-matrix
		      (if test-id
			  (list (db:test-get-host     test-data)
				(db:test-get-uname    test-data)
				(db:test-get-diskfree test-data)
				(db:test-get-cpuload  test-data)
				(seconds->hr-min-sec (db:test-get-run_duration test-data)))
			  (make-list 5 "")))
		))
	      (dcommon:populate-steps steps-dat steps-matrix))))))
;;(list meta-dat-matrix
;;      (if test-id
;;	  (list (
 

;;======================================================================
;; R U N   C O N T R O L
;;======================================================================

;; General displayer
;;
(define (dashboard:area-display data adat window-id)
  (let* ((view-matrix     (iup:matrix
			   ;; (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f))
			   #:expand "YES"
			   ;; #:fittosize "YES"
			   #:scrollbar "YES"
			   #:numcol 100
			   #:numlin 100
			   #:numcol-visible 3
			   #:numlin-visible 3
			   #:click-cb (lambda (obj lin col status)
					(print "obj: " obj " lin: " lin " col: " col " status: " status)))))

    (iup:attribute-set! view-matrix "RESIZEMATRIX" "YES")
    (iup:attribute-set! view-matrix "WIDTH0" "100")
    ;; (dboard:data-set-runs-matrix! *data* runs-matrix)
    (iup:hbox
     (iup:frame 
      #:title "Runs browser"
      (iup:vbox
       view-matrix)))))

;; Browse and control a single run
;;
(define (runcontrol window-id)
  (iup:hbox))

;; NB// Wierd conflict error here
;;
;;		     (let* ((runs-dat     (db:get-runs-by-patt db *keys* "%" #f #f #f #f))

;;======================================================================
;; A R E A S
;;======================================================================

(define (dashboard:init-area data area-name apath)
  (let* ((mtconffile  (conc area-name "/megatest.config"))
	 (mtconf      (read-config mtconffile (make-hash-table) #f)) ;; megatest.config
	 (area-dat    (let ((ad (make-megatest:area
			       area-name ;; area name
			       apath     ;; path to area
			       'http     ;; transport
			       (list apath mtconf) ;; configinfo (legacy)
			       mtconf    ;; megatest.config
			       (make-hash-table) ;; denoise hash
			       #f        ;; client-signature
			       #f        ;; remote connections
			       #f        ;; run keys
			       (make-hash-table) ;; run-id -> (hash of test-ids => dat)
			       (and (file-exists? apath)(file-write-access? apath)) ;; read-only
			       )))
		      (hash-table-set! (dboard:data-areas data) area-name ad)
		      ad)))
    area-dat))

;;======================================================================
;; D A S H B O A R D
;;======================================================================

;; Main Panel
;;
(define (dashboard:main-panel data window-id)
  (iup:dialog
   #:title "Megatest Control Panel"
   #:menu (dcommon:main-menu data)
   #:shrink "YES"
   (iup:vbox
    (let* ((area-names  (hash-table-keys (dboard:data-cfgdat data)))
	   (area-panels (map (lambda (aname)
			       (let* ((apath      (configf:lookup (dboard:data-cfgdat data) aname "path")) ;;  (hash-table-ref (dboard:data-cfgdat data) area-name))
				      ;;          (hash-table-ref (dboard:data-cfgdat data) aname))
				      (area-dat   (dashboard:init-area data aname apath))
				      (tb         (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data)
				      (ad         (dashboard:area-display data area-dat window-id))
				      (areas      (dboard:data-areas data))
				      (dboard-dat (make-dboard:tab
						   #f           ;; tree
						   #f           ;; matrix
						   area-dat     ;;
						   #f           ;; view path
						   'default     ;; view type
						   #f           ;; controls
						   #f           ;; cached data
						   #f           ;; filters
						   #f           ;; the run-id
						   (make-hash-table) ;; run-id -> test-id, for current test id
						   ""
						   )))
				 (hash-table-set! (dboard:data-areas data) aname dboard-dat)
				 (dboard:tab-tree-set!   dboard-dat tb)
				 (dboard:tab-matrix-set! dboard-dat ad)
				 (iup:split
				  #:value 200
				  tb ad)))
			     area-names))
	   (tabtop      (apply iup:tabs  
			       #:tabchangepos-cb (lambda (obj curr prev)
						   (dboard:data-current-tab-id-set! data curr)
						   (dboard:data-update-needed-set!  data #t)
						   (print "Tab is: " curr ", prev was " prev))
			       area-panels))
	   (tab-ids     (dboard:data-tab-ids data)))
      (let loop ((index 0)
		 (hed   (car area-names))
		 (tal   (cdr area-names)))
	(hash-table-set! tab-ids index hed)
	(debug:print 0 "Adding area " hed " with index " index " to dashboard")
	(iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
	(if (not (null? tal))
	    (loop (+ index 1)(car tal)(cdr tal))))
      tabtop))))

(define (newdashboard data window-id)
  (let* (;; (keys     (db:get-keys *dbstruct-local* *area-dat*))
	 ;; (runname  "%")
	 ;; (testpatt "%")
	 ;; (keypatts (map (lambda (k)(list k "%")) keys))
	 ;; (states   '())
	 ;; (statuses '())
	 (nextmintime (current-milliseconds)))
    (dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data)))
    ;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
    (iup:show (dashboard:main-panel data (dboard:data-current-window-id data)))
    ;; Yes, running iup:show will pop up a new panel
    ;; (iup:show (main-panel my-window-id))
    (iup:callback-set! *tim*
		       "ACTION_CB"
		       (lambda (x)
			 (let ((starttime (current-milliseconds)))
			   ;; Want to dedicate no more than 50% of the time to this so skip if
			   ;; 2x delta time has not passed since last query
			   ;; (if (< (inexact->exact nextmintime)(inexact->exact starttime))
			   ;;     (let* ((changes   (dcommon:run-update data)) ;;keys data runname keypatts testpatt states statuses 'full my-window-id))
			   ;;            (endtime   (current-milliseconds)))
			   ;;       (set! nextmintime (+ endtime (* 2.0 (- endtime starttime))))
			   ;;       ;; (debug:print 11 "CHANGE(S): " (car changes) "...")
			   ;;       )
			   ;;     (debug:print-info 11 "Server overloaded")))))))
			   (dcommon:run-update data))))))

;;; main. Theoretically could have multiple windows (each with a group of tags, thus window-id
;;;
(let* ((window-id 0)
       (groupn    (or (args:get-arg "-group") "default"))
       (cfname    (conc (getenv "HOME") "/.megatest/" groupn ".dat"))
       (cfgdat    (if (file-exists? cfname)(read-config cfname (make-hash-table) #t)))
       (data      (make-dboard:data
		   cfgdat ;; this is the data from ~/.megatest for the selected group
		   (make-hash-table) ;; areaname -> area-rec
		   0                 ;; current window id
		   0                 ;; current tab id
		   #f                ;; redraw needed for current tab id
		   (make-hash-table) ;; tab-id -> areaname
		   )))
  (newdashboard data window-id)
  (iup:main-loop))

	      (common:del-remote! remote run-id)
	      ;; (mutex-unlock! *send-receive-mutex*)
	      (if (and faststart (equal? faststart "no"))
		  (begin
		    (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db area-dat)) run-id 10)
		    (thread-sleep! (random 5)) ;; give some time to settle and minimize collison?
		    (rmt:send-receive cmd rid params area-dat attemptnum: (+ attemptnum 1)))
		  (let ((start-time (current-milliseconds))
			(max-query  (string->number (or (configf:lookup *configdat* "server" "server-query-threshold")
							"300")))
			(newres     (rmt:open-qry-close-locally cmd run-id params)))
		    (let ((delta (- (current-milliseconds) start-time)))
		      (if (> delta max-query)
		  (begin
		    (server:kind-run run-id area-dat)
		    (rmt:open-qry-close-locally cmd run-id area-dat params))))
			  (begin
		    ;; (server:kind-run run-id area-dat)
		    ;; (rmt:open-qry-close-locally cmd run-id area-dat params))))
			    (debug:print-info 0 "Starting server as query time " delta " is over the limit of " max-query)
			    (server:kind-run run-id)))
		      ;; return the result!
		      newres)
		    )))
	    (begin
	      ;; (debug:print 0 "ERROR: Communication failed!")
	      ;; (mutex-unlock! *send-receive-mutex*)
	      ;; (exit)
	      (rmt:open-qry-close-locally cmd run-id area-dat params)
	      )))))

;;
(define (rmt:get-key-val-pairs run-id area-dat)
  (rmt:send-receive 'get-key-val-pairs run-id (list run-id) area-dat))

(define (rmt:get-keys area-dat)
  (rmt:send-receive 'get-keys #f '() area-dat))

(define (rmt:get-key-vals run-id)
  (rmt:send-receive 'get-key-vals #f (list run-id)))

(define (rmt:get-targets)
  (rmt:send-receive 'get-targets #f '()))

;;======================================================================
;;  T E S T S
;;======================================================================

;; Just some syntatic sugar NOTE: Need to add area-dat
(define (rmt:register-test run-id test-name item-path)
  (rmt:general-call 'register-test run-id run-id test-name item-path))

(define (rmt:get-test-id run-id testname item-path area-dat)
  (rmt:send-receive 'get-test-id run-id (list run-id testname item-path) area-dat))

(define (rmt:get-test-info-by-id run-id test-id area-dat)
  (if (and (number? run-id)(number? test-id))
      (rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id) area-dat)
      (begin

	   (map (lambda (run-id)
		  (rmt:send-receive 'test-get-paths-matching-keynames-target-new run-id (list run-id keynames target res testpatt statepatt statuspatt runname) area-dat))
	   run-ids))))

(define (rmt:get-run-ids-matching keynames target res area-dat)
  (rmt:send-receive #f 'get-run-ids-matching (list keynames target res) area-dat) area-dat)

(define (rmt:get-prereqs-not-met run-id waitons ref-item-path area-dat #!key (mode '(normal)))
  (rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-item-path mode) area-dat))
(define (rmt:get-prereqs-not-met run-id waitons ref-item-path area-dat #!key (mode '(normal))(itemmap #f))
  (rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-item-path mode itemmap) area-dat))

(define (rmt:get-count-tests-running-for-run-id run-id area-dat)
  (rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id) area-dat))

;; Statistical queries

(define (rmt:get-count-tests-running run-id area-dat)
  (rmt:send-receive 'get-count-tests-running run-id (list run-id) area-dat))

(define (rmt:get-count-tests-running-for-testname run-id testname area-dat)
  (rmt:send-receive 'get-count-tests-running-for-testname run-id (list run-id testname) area-dat))

(define (rmt:get-count-tests-running-in-jobgroup run-id jobgroup area-dat)
  (rmt:send-receive 'get-count-tests-running-in-jobgroup run-id (list run-id jobgroup) area-dat))

;; state and status are extra hints not usually used in the calculation
;;
(define (rmt:roll-up-pass-fail-counts run-id test-name item-path status area-dat)
  (rmt:send-receive 'roll-up-pass-fail-counts run-id (list run-id test-name item-path status) area-dat))
(define (rmt:roll-up-pass-fail-counts run-id test-name item-path state status area-dat)
  (rmt:send-receive 'roll-up-pass-fail-counts run-id (list run-id test-name item-path state status) area-dat))

(define (rmt:update-pass-fail-counts run-id test-name area-dat)
  (rmt:general-call 'update-fail-pass-counts run-id (list run-id test-name run-id test-name run-id test-name) area-dat))

;;======================================================================
;;  R U N S
;;======================================================================

(define (rmt:get-run-info run-id area-dat)
  (rmt:send-receive 'get-run-info run-id (list run-id) area-dat))

(define (rmt:get-num-runs runpatt)
  (rmt:send-receive 'get-num-runs #f (list runpatt)))

;; Use the special run-id == #f scenario here since there is no run yet
(define (rmt:register-run keyvals runname state status user area-dat)
  (rmt:send-receive 'register-run #f (list keyvals runname state status user) area-dat))
    
(define (rmt:get-run-name-from-id run-id area-dat)
  (rmt:send-receive 'get-run-name-from-id run-id (list run-id) area-dat))

    ;; Now generate all the tests lists
    (set! all-tests-registry (tests:get-all area-dat))
    (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! required-tests     (lset-intersection equal? (string-split test-patts ",") all-test-names))
    (set! required-tests     (lset-intersection equal? test-names all-test-names))
    (set! required-tests     (lset-intersection equal? (string-split test-patts ",") all-test-names))
    ;; (set! required-tests     (lset-intersection equal? test-names all-test-names))
    
    ;; look up all tests matching the comma separated list of globs in
    ;; test-patts (using % as wildcard)

    ;; (set! test-names (delete-duplicates (tests:get-valid-tests toppath test-patts)))
    (debug:print-info 0 "tests search path: " (string-intersperse (tests:get-tests-search-path configdat area-dat) " "))
    ;; (debug:print-info 0 "tests search path: " (string-intersperse (tests:get-tests-search-path *configdat*) " "))

	  ;; have to delete test records where NOT_STARTED since they can cause -keepgoing to 
	  ;; get stuck due to becoming inaccessible from a failed test. I.e. if test B depends 
	  ;; on test A but test B reached the point on being registered as NOT_STARTED and test
	  ;; A failed for some reason then on re-run using -keepgoing the run can never complete.
	  ;;
	  ;; (rmt:general-call 'delete-tests-in-state run-id "NOT_STARTED")
	  
	  ;; Now convert FAIL and anything in allow-auto-rerun to NOT_STARTED
	  ;; Now convert anything in allow-auto-rerun to NOT_STARTED
	  ;;
	  (for-each (lambda (state)
		      (rmt:set-tests-state-status run-id test-names state #f "NOT_STARTED" state area-dat))
		    (string-split (or (configf:lookup configdat "setup" "allow-auto-rerun") "")))))

    ;; Ensure all tests are registered in the test_meta table
    (runs:update-all-test_meta #f area-dat)

	  '()
	  reg)))

(define runs:nothing-left-in-queue-count 0)

(define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmap area-dat)
  (let* ((loop-list       (list hed tal reg reruns))
	 (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path area-dat itemmap: itemmap))
	 (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path area-dat mode: testmode itemmap: itemmap))
	 ;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
	 (fails           (runs:calc-fails prereqs-not-met))
	 (prereq-fails    (runs:calc-prereq-fail prereqs-not-met))
	 (non-completed   (runs:calc-not-completed prereqs-not-met))
	 (runnables       (runs:calc-runnable prereqs-not-met)))
    (debug:print-info 4 "START OF INNER COND #2 "
		      "\n can-run-more:    " can-run-more

	 (toppath                 (megatest:area-path      area-dat))
	 (run-limits-info         (runs:can-run-more-tests run-id jobgroup max-concurrent-jobs area-dat)) ;; look at the test jobgroup and tot jobs running
	 (have-resources          (car run-limits-info))
	 (num-running             (list-ref run-limits-info 1))
	 (num-running-in-jobgroup (list-ref run-limits-info 2)) 
	 (max-concurrent-jobs     (list-ref run-limits-info 3))
	 (job-group-limit         (list-ref run-limits-info 4))
	 (prereqs-not-met         (rmt:get-prereqs-not-met run-id waitons item-path testmode area-dat itemmap: itemmap))
	 (prereqs-not-met         (rmt:get-prereqs-not-met run-id waitons item-path area-dat mode: testmode itemmap: itemmap))
	 ;; (prereqs-not-met         (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
	 (fails                   (runs:calc-fails prereqs-not-met))
	 (non-completed           (filter (lambda (x)             ;; remove hed from not completed list, duh, of course it is not completed!
					    (not (equal? x hed)))
					  (runs:calc-not-completed prereqs-not-met)))
	 (loop-list               (list hed tal reg reruns))
	 ;; configure the load runner

     
     ;; Register tests 
     ;;
     ((not (hash-table-ref/default test-registry (db:test-make-full-name test-name item-path) #f))
      (debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" )
      ;; always do firm registration now in v1.60 and greater ;; (eq? *transport-type* 'fs) ;; no point in parallel registration if use fs
      (let register-loop ((numtries 15))
	(rmt:general-call 'register-test run-id area-dat run-id test-name item-path)
	(rmt:register-test area-dat run-id test-name item-path)
	(if (rmt:get-test-id run-id test-name item-path)
	    (hash-table-set! test-registry (db:test-make-full-name test-name item-path) 'done)
	    (if (> numtries 0)
		(begin
		  (thread-sleep! 0.5)
		  (register-loop (- numtries 1)))
		(debug:print 0 "ERROR: failed to register test " (db:test-make-full-name test-name item-path)))))
      (if (not (eq? (hash-table-ref/default test-registry (db:test-make-full-name test-name "") #f) 'done))
	  (begin
	    (rmt:general-call 'register-test run-id area-dat run-id test-name "")
	    (rmt:register-test area-dat run-id test-name "")
	    (if (rmt:get-test-id run-id test-name "")
		(hash-table-set! test-registry (db:test-make-full-name test-name "") 'done))))
      (runs:shrink-can-run-more-tests-count)   ;; DELAY TWEAKER (still needed?)
      (if (and (null? tal)(null? reg))
	  (list hed tal (append reg (list hed)) reruns)
	  (list (runs:queue-next-hed tal reg reglen regfull)
		(runs:queue-next-tal tal reg reglen regfull)

		     (else
		      (if (runs:lownoise (conc "FAILED prerequitests and we tried" hed) 60)
			  (debug:print 0 "WARNING: test " hed " has FAILED prerequitests and we've tried at least 10 times to run it. Giving up now."))
		      ;; (debug:print 0 "         prereqs: " prereqs-not-met)
		      (hash-table-set! test-registry hed 'removed)
		      (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "TEN_STRIKES" #f)
		      ;; I'm unclear on if this roll up is needed - it may be the root cause of the "all set to FAIL" bug.
		      (rmt:roll-up-pass-fail-counts run-id test-name item-path "FAIL") ;; treat as FAIL
		      (rmt:roll-up-pass-fail-counts run-id test-name item-path #f "FAIL") ;; treat as FAIL
		      (list (if (null? tal)(car newtal)(car tal))
			    tal
			    reg
			    reruns)))))
	      ;; can't drop this - maybe running? Just keep trying
	      (let ((runable-tests (runs:runable-tests prereqs-not-met)))
		(if (null? runable-tests)

(define (runs:runable-tests tests)
  (filter (lambda (t)
	    (if (not (vector? t))
		t
		(let ((state  (db:test-get-state t))
		      (status (db:test-get-status t)))
		  (case (string->symbol state)
		    ((COMPLETED) #f)
		    ((COMPLETED INCOMPLETE) #f)
		    ((NOT_STARTED)
		     (if (member status '("TEN_STRIKES" "BLOCKED" "PREQ_FAIL" "ZERO_ITEMS" "PREQ_DISCARDED" "TIMED_OUT" ))
			 #f
			 t))
		    ((DELETED) #f)
		    (else t)))))
	  tests))

	  (hash-table-set! *max-tries-hash* tfullname (+ (hash-table-ref/default *max-tries-hash* tfullname 0) 1)))
	;; (debug:print 0 "max-tries-hash: " (hash-table->alist *max-tries-hash*))

	;; Ensure all top level tests get registered. This way they show up as "NOT_STARTED" on the dashboard
	;; and it is clear they *should* have run but did not.
	(if (not (hash-table-ref/default test-registry (db:test-make-full-name test-name "") #f))
	    (begin
	      (rmt:general-call 'register-test run-id area-dat run-id test-name "" area-dat)
	      (rmt:register-test area-dat run-id test-name "")
	      (hash-table-set! test-registry (db:test-make-full-name test-name "") 'done)))
	
	;; Fast skip of tests that are already "COMPLETED" - NO! Cannot do that as the items may not have been expanded yet :(
	;;
	(if (member (hash-table-ref/default test-registry tfullname #f) 
		    '(DONOTRUN removed)) ;; *common:cant-run-states-sym*) ;; '(COMPLETED KILLED WAIVED UNKNOWN INCOMPLETE))
	    (begin

    ;; LET* ((test-record
    ;; we get here on "drop through". All done!
    (debug:print-info 1 "All tests launched")))

(define (runs:calc-fails prereqs-not-met)
  (filter (lambda (test)
	    (and (vector? test) ;; not (string? test))
		 (equal? (db:test-get-state test) "COMPLETED")
		 (member (db:test-get-state test) '("INCOMPLETE" "COMPLETED"))
		 (not (member (db:test-get-status test)
			      '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))))
	  prereqs-not-met))

(define (runs:calc-prereq-fail prereqs-not-met)
  (filter (lambda (test)
	    (and (vector? test) ;; not (string? test))
		 (equal? (db:test-get-state test) "NOT_STARTED")
		 (not (member (db:test-get-status test)
			      '("n/a" "KEEP_TRYING")))))
	  prereqs-not-met))

(define (runs:calc-not-completed prereqs-not-met)
  (filter
   (lambda (t)
     (or (not (vector? t))
	 (not (equal? "COMPLETED" (db:test-get-state t)))))
	 (not (member (db:test-get-state t) '("INCOMPLETE" "COMPLETED")))))
   prereqs-not-met))

(define (runs:calc-not-completed prereqs-not-met)
  (filter
   (lambda (t)
     (or (not (vector? t))
	 (not (equal? "COMPLETED" (db:test-get-state t)))))
   prereqs-not-met))
;; (define (runs:calc-not-completed prereqs-not-met)
;;   (filter
;;    (lambda (t)
;;      (or (not (vector? t))
;; 	 (not (equal? "COMPLETED" (db:test-get-state t)))))
;;    prereqs-not-met))

(define (runs:calc-runnable prereqs-not-met)
  (filter 
   (lambda (t)
     (or (not (vector? t))
	 (and (equal? "NOT_STARTED" (db:test-get-state t))
	      (member (db:test-get-status t)

	    ;;
	    ;; NB// for the above line. I want the test to be registered long before this routine gets called!
	    ;;
	    (if (not test-id)(set! test-id (rmt:get-test-id run-id test-name item-path area-dat)))
	    (if (not test-id)
		(begin
		  (debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id)
		  (rmt:general-call 'register-test run-id area-dat run-id test-name item-path area-dat)
		  (rmt:register-test area-dat run-id test-name item-path)
		  (set! test-id (rmt:get-test-id run-id test-name item-path area-dat))))
	    (debug:print-info 4 "test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
	    (set! testdat (rmt:get-test-info-by-id run-id test-id area-dat))
	    (if (not testdat)
		(begin
		  (debug:print-info 0 "WARNING: server is overloaded, trying again in one second")
		  (thread-sleep! 1)

      (case (if force ;; (args:get-arg "-force")
		'NOT_STARTED
		(if testdat
		    (string->symbol (test:get-state testdat))
		    'failed-to-insert))
	((failed-to-insert)
	 (debug:print 0 "ERROR: Failed to insert the record into the db"))
	((NOT_STARTED COMPLETED DELETED)
	((NOT_STARTED COMPLETED DELETED INCOMPLETE)
	 (let ((runflag #f))
	   (cond
	    ;; -force, run no matter what
	    (force (set! runflag #t))
	    ;; NOT_STARTED, run no matter what
	    ((member (test:get-state testdat) '("DELETED" "NOT_STARTED"))(set! runflag #t))
	    ((member (test:get-state testdat) '("DELETED" "NOT_STARTED" "INCOMPLETE"))(set! runflag #t))
	    ;; not -rerun and PASS, WARN or CHECK, do no run
	    ((and (or (not rerun)
		      keepgoing)
		  ;; Require to force re-run for COMPLETED or *anything* + PASS,WARN or CHECK
		  (or (member (test:get-status testdat) '("PASS" "WARN" "CHECK" "SKIP" "WAIVED"))
		      (member (test:get-state  testdat) '("COMPLETED")))) 
	     (debug:print-info 2 "running test " test-name "/" item-path " suppressed as it is " (test:get-state testdat) " and " (test:get-status testdat))

		       (set! skip-test (conc "Skipping due to existance of file " (configf:lookup test-conf "skip" "fileexists")))))

		  ((and skip-check
			(configf:lookup test-conf "skip" "rundelay"))
		   ;; run-ids = #f means *all* runs
		   (let* ((numseconds      (common:hms-string->seconds (configf:lookup test-conf "skip" "rundelay")))
			  (running-tests   (rmt:get-tests-for-runs-mindata #f full-test-name '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED") '() #f))
			  (completed-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("COMPLETED") '("PASS" "FAIL" "ABORT") #f))
			  (completed-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("COMPLETED" "INCOMPLETE") '("PASS" "FAIL" "ABORT") #f)) ;; ironically INCOMPLETE is same as COMPLETED in this contex
			  (last-run-times  (map db:mintest-get-event_time completed-tests))
			  (time-since-last (- (current-seconds) (if (null? last-run-times) 0 (apply max last-run-times)))))
		     (if (or (not (null? running-tests)) ;; have to skip if test is running
			     (> numseconds time-since-last))
			 (set! skip-test (conc "Skipping due to previous test run less than " (configf:lookup test-conf "skip" "rundelay") " ago"))))))
		 
		 (if skip-test

;;======================================================================

;;======================================================================
;; T E S T   S P E C I F I C   D B 
;;======================================================================

;; Create the sqlite db for the individual test(s)
(define (open-test-db work-area area-dat) 
;;
;; Moved these tables into <runid>.db
;; THIS CODE TO BE REMOVED
;;
  (debug:print-info 11 "open-test-db " work-area)
  (if (and work-area 
	   (directory? work-area)
	   (file-read-access? work-area))
      (let* ((dbpath              (conc work-area "/testdat.db"))
	     (dbexists            (file-exists? dbpath))
	     (work-area-writeable (file-write-access? work-area))

              id INTEGER PRIMARY KEY,
              var TEXT,
              val TEXT,
              ackstate INTEGER DEFAULT 0,
              CONSTRAINT metadat_constraint UNIQUE (var));"))))
  (debug:print 11 "db:testdb-initialize END"))

;; This routine moved to db:read-test-data
;;
(define (tdb:read-test-data tdb test-id categorypatt)
  (let ((res '()))
    (sqlite3:for-each-row 
     (lambda (id test_id category variable value expected tol units comment status type)
       (set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
     tdb
     "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)

;; S T E P S 
;;======================================================================

(define (tdb:step-get-time-as-string vec)
  (seconds->time-string (tdb:step-get-event_time vec)))

;; get a pretty table to summarize steps
;; 
;; NOT USED, WILL BE REMOVED
;;
(define (tdb:get-steps-table steps);; organise the steps for better readability
  (let ((res (make-hash-table)))
    (for-each 
     (lambda (step)
       (debug:print 6 "step=" step)
       (let ((record (hash-table-ref/default 

;; watch nanomsg's pipeline load-balancer in action.
(use nanomsg)

(define req   (nn-socket 'req))

(nn-connect req  "tcp://localhost:22022")

;; (with-output-to-string (lambda ()(serialize obj)))
(define (client-send-receive soc msg)
  (nn-send soc msg)
  (nn-recv soc))

(define ((talk-to-server soc))
  (let loop ((cnt 20))
  (let loop ((cnt 2000))
    (let ((name (list-ref '("Matt" "Tom" "Bob" "Jill" "James" "Jane")(random 6))))
      (print "Sending " name)
      (print (client-send-receive req name))
      (if (> cnt 0)(loop (- cnt 1)))))
  (print (client-send-receive req "quit"))
  (nn-close req)
  (exit))

      (nn-send soc "Ok, quitting"))
     ((and (>= (string-length msg-in) 4)
	   (equal? (substring msg-in 0 4) "ping"))
      (nn-send soc (conc (current-process-id)))
      (loop (nn-recv soc)))
     ;;((and (>= (string-length msg-in)
     (else
      (let ((this-task (random 15)))
	(thread-sleep! this-task)
      (let ((this-task (random 10)))
	(thread-sleep! (/ this-task 10.0))
	(nn-send soc (conc "hello " msg-in " this task took " this-task " seconds to complete"))
	(loop (nn-recv soc)))))))

(define (ping-self host port #!key (return-socket #t))
  ;; send a random number along with pid and check that we get it back
  (let* ((req     (nn-socket 'req))
	 (key     "ping")

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")

;; Call this one to do all the work and get a standardized list of tests
(define (tests:get-all area-dat)
  (let* ((test-search-path   (tests:get-tests-search-path (megatest:area-configdat area-dat) area-dat)))
;;   gets paths from configs and finds valid tests 
;;   returns hash of testname --> fullpath
;;
    (tests:get-valid-tests (make-hash-table) test-search-path)))

(define (tests:get-tests-search-path cfgdat area-dat)
  (let ((paths (map cadr (configf:get-section cfgdat "tests-paths"))))
    (filter (lambda (d)
    (append paths (list (conc (megatest:area-path area-dat) "/tests")))))
;;     (append paths (list (conc (megatest:area-path area-dat) "/tests")))))
	      (if (directory-exists? d)
		  d
		  (begin
		    (debug:print 0 "WARNING: problem with directory " d ", dropping it from tests path")
		    #f)))
	    (append paths (list (conc *toppath* "/tests"))))))

(define (tests:get-valid-tests test-registry tests-paths)
  (if (null? tests-paths) 
      test-registry
      (let loop ((hed (car tests-paths))
		 (tal (cdr tests-paths)))
	(if (file-exists? hed)

			   type     )))
	    ;; This was run remote, don't think that makes sense. Perhaps not, but that is the easiest path for the moment.
	    (rmt:csv->test-data run-id test-id
				dat))))
      
    ;; need to update the top test record if PASS or FAIL and this is a subtest
    (if (not (equal? item-path ""))
	(rmt:roll-up-pass-fail-counts run-id test-name item-path status))
	(rmt:roll-up-pass-fail-counts run-id test-name item-path state status))

    (if (or (and (string? comment)
		 (string-match (regexp "\\S+") comment))
	    waived)
	(let ((cmt  (if waived waived comment)))
	  (rmt:general-call 'set-test-comment run-id cmt test-id)))))

;;     (set! tests (filter (lambda (test)(file-exists? (conc test "/testconfig"))) tests))
;;     (delete-duplicates
;;      (filter (lambda (testname)
;; 	       (tests:match test-patts testname #f))
;; 	     (map (lambda (testp)
;; 		    (last (string-split testp "/")))
;; 		  tests)))))


(define (tests:get-testconfig test-name test-registry system-allowed area-dat)
  (let* ((test-path    (hash-table-ref/default test-registry test-name (conc (megatest:area-path area-dat) "/tests/" test-name)))
	 (test-configf (conc test-path "/testconfig"))
	 (testexists   (and (file-exists? test-configf)(file-read-access? test-configf)))
	 (tcfg         (if testexists
			   (read-config test-configf #f system-allowed environ-patt: (if system-allowed

	       ;; from the runnable list
	       (if keep-test
		   (for-each (lambda (waiton)
			       ;; for now we are waiting only on the parent test
			       (let* ((parent-test-id (rmt:get-test-id run-id waiton ""))
				      (wtdat          (rmt:get-testinfo-state-status run-id test-id))) ;; (cdb:get-test-info-by-id (common:get-remote remote) test-id)))
				 (if (or (and (equal? (db:test-get-state wtdat) "COMPLETED")
					      (member (db:test-get-status wtdat) '("FAIL")))
					      (member (db:test-get-status wtdat) '("FAIL" "ABORT")))
					 (member (db:test-get-status wtdat)  '("KILLED"))
					 (member (db:test-get-state wtdat)   '("INCOMPETE")))
				 ;; (if (or (member (db:test-get-status wtdat)
				 ;;        	 '("FAIL" "KILLED"))
				 ;;         (member (db:test-get-state wtdat)
				 ;;        	 '("INCOMPETE")))
				     (set! keep-test #f)))) ;; no point in running this one again

FS  = $(shell df -T .|tail -1|awk '{print $$2}')
VER = $(shell fsl info|grep checkout|awk '{print $$2}'|cut -c 1-5)

# The NEWTARGET causes some tests to fail. Do not use until this is fixed.
NEWTARGET  = "$(OS)/$(FS)/$(VER)"
TARGET     = "ubuntu/nfs/none"

all : unit test1 test2 test3 test4 test5 test6 test7 test8 test9
all : build unit test1 test2 test3 test4 test5 test6 test7 test8 test9

unit :
	./rununittest.sh basicserver $(DEBUG)
unit : basicserver.log runs.log misc.log

rel : 
	cd release;dashboard -rows 25 &

## basicserver.log : unittests/basicserver.scm
## 	script -c "./rununittest.sh basicserver $(DEBUG)" basicserver.log

%.log : build unittests/%.scm
	script -c "./rununittest.sh $* $(DEBUG)" $*.log
	if logpro unit.logpro $*.html < $*.log > /dev/null;then echo ALLPASS;else echo ALLFAIL;mv $*.log $*.log.FAIL;fi

server :
	cd ..;make -j;make install
	cd fullrun;$(MEGATEST) -server - -debug $(DEBUG) -run-id $(RUNID)

stopserver :
	cd ..;make -j && make install
	cd fullrun;$(MEGATEST) -stop-server 0

repl :
	cd ..;make -j && make install
	cd fullrun;$(MEGATEST) -:b -repl

test0 : cleanprep
	cd simplerun ; $(MEGATEST) -server - -debug $(DEBUG)

test1 : cleanprep

	     for dpath in none tmp; do \
	        (cd fullrun;$(MEGATEST) -preclean -runtests priority_10_waiton_1 -target $$sys/$$fs/$$dpath :runname $(RUNNAME) &);\
	     done;done;done

test11 :
	 cd fullrun;time (for a in 1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10 ;do   (megatest -test-paths -target %/%/% > /dev/null ) & done; wait; )

minsetup : 
build : ../*.scm
	if killall mtest -v ;then sleep 5;killall mtest -v -9;fi
	cd ..;make -j && make install
	touch build

cleanstart :
	killall mtest -v;if [ ! $$? ];then sleep 5;killall mtest -v -9;fi

minsetup : build
	mkdir -p mintest/runs mintest/links
	cd mintest;$(MEGATEST) -stop-server 0
	cd mintest;$(MEGATEST) -server - -debug $(DEBUG) > server.log 2> server.log & 
	sleep 3
	cd mintest;$(DASHBOARD) -rows 18 &

cleanprep : ../*.scm Makefile */*.config
cleanprep : ../*.scm Makefile */*.config build
	mkdir -p fullrun/tmp/mt_runs fullrun/tmp/mt_links /tmp/$(USER)/adisk1
	cd ..;make -j;make install
	rm -f */logging.db
	touch cleanprep

fullprep : cleanprep
	cd fullrun;$(MEGATEST) -remove-runs :runname $(RUNNAME)% -target %/%/% -testpatt %/%
	cd fullrun;$(BINPATH)/dashboard -rows 15 &

# force server
server-query-threshold 0


[jobtools]
# launcher nbq -P ch_vp -C SLES11_EM64T_4G -Q /ciaf/fdk
# launcher nbfake
# maxload 4
launcher nbfake
maxload 4

launcher bsub -q priority -o $MT_TEST_RUN_DIR/openlava.log 
# launcher bsub -q priority -o $MT_TEST_RUN_DIR/openlava.log 

BINDIR    = $(PWD)/../../../bin
PATH     := $(BINDIR):$(PATH)
MEGATEST  = $(BINDIR)/megatest
DASHBOARD = $(BINDIR)/dashboard
NEWDASHBOARD = $(BINDIR)/newdashboard
RUNNAME   = a

NUMTESTS  = 20

all :
	$(MEGATEST) -remove-runs -target a/b :runname c -testpatt %/%
	$(MEGATEST) -runtests % -target a/b :runname c

bigbig :
	for tn in a b c d;do \
	   ($(MEGATEST) -runtests % -target a/b :runname $tn & ) ; \
	done

bigrun :
	$(MEGATEST) -runtests bigrun -target a/bigrun :runname a$(shell date +%V)
	NUMTESTS=$(NUMTESTS) $(MEGATEST) -runtests bigrun -target a/bigrun :runname a$(shell date +%V)

bigrun2 :
	$(MEGATEST) -runtests bigrun2 -target a/bigrun2 :runname a$(shell date +%V)
	NUMTESTS=$(NUMTESTS) $(MEGATEST) -runtests bigrun2 -target a/bigrun2 :runname a$(shell date +%V)

bigrun3 :
	$(MEGATEST) -runtests bigrun3 -target a/bigrun3 :runname $(RUNNAME)
	NUMTESTS=$(NUMTESTS) $(MEGATEST) -runtests bigrun3 -target a/bigrun3 :runname $(RUNNAME)

dashboard : 
	mkdir -p ../simpleruns
	$(DASHBOARD) -rows 20 &

newdashboard :
	$(NEWDASHBOARD) &

compile :
	(cd ../../..;make -j && make install)

MYRUNNAME2 /this/is/[system echo $MT_RUNNAME]/my/runname


# XTERM   [system xterm]
# RUNDEAD [system exit 56]

[server]

# force use of server always
required yes

# Use http instead of direct filesystem access
transport http
# transport fs
# transport nmsg

synchronous 0

# If the server can't be started on this port it will try the next port until
# it succeeds
port 9080

# This server will keep running this number of hours after last access. 
# Three minutes is 0.05 hours
# timeout 0.025
timeout 0.061

# faststart; unless no, start server but proceed with writes until server started
faststart no
faststart yes
# faststart yes

# Start server when average query takes longer than this
# server-query-threshold 55500
server-query-threshold 100
server-query-threshold 1000
timeout 0.01

# daemonize yes
# hostname #{scheme (get-host-name)}

## disks are:
## name host:/path/to/area

#  <testsuite>/<creationdate>
# Within the archive the data is structured like this:
#  <target>/<runname>/<test>/
disk0 /tmp/#{getenv USER}/adisk1

# Uncomment these to emulate a job queue with a long time (look in bin/sleeprunner for the time)
[jobtools]
launcher #{scheme (case (string->symbol (conc (getenv "datapath"))) \
                      ((none) "nbfake") \
                      ((openlava) "bsub") \
                      (else "sleeprunner"))}
# launcher #{ scheme (case (string->symbol (conc (getenv "datapath"))) \
#                         ((none) "nbfake") \
#                         ((openlava) "bsub") \
#                         (else "sleeprunner"))}

# launcher bsub -q priority -o $MT_TEST_RUN_DIR/openlava.log 

# launcher #{shell if which bsub > /dev/null;then echo bsub -q priority -o openlava.log;else echo sleeprunner;fi}
launcher nbfake

[configf:settings trim-trailing-spaces yes]

[test]
# VAL1 has trailing spaces
VAL1 Foo    
VAL2 ==>#{get test VAL1}Bar<== no spaces between Foo and Bar to pass

ltest #{scheme (case (string->symbol (conc (getenv "datapath"))) \
                        ((none) "nbfake") \
                        ((openlava) "bsub") \
                        (else "sleeprunner"))}

dashboard : compile
	dashboard -rows 24 &

compile : runs
	cd ../..;make -j install

runs :
	mkdir -p runs

[fields]
release TEXT
iteration TEXT

[setup]
linktree #{getenv MT_RUN_AREA_HOME}/links
max_concurrent_jobs 100
logviewer (%MTCMD%) 2> /dev/null > /dev/null
# htmlviewercmd firefox -new-window 
htmlviewercmd arora

[jobtools]
# launcher #{shell if which bsub > /dev/null;then echo bsub;else echo nbfake;fi}
launcher nbfake
maxload 2.5

[server]
required yes

[disks]
disk0 #{getenv MT_RUN_AREA_HOME}/runs

[default]
MTRUNNER   #{shell readlink -f #{getenv MT_RUN_AREA_HOME}/../../utils/mtrunner}
MTTESTDIR  #{shell readlink -f #{getenv MT_RUN_AREA_HOME}/..}
MTPATH     #{shell readlink -f #{getenv MT_RUN_AREA_HOME}/../../bin}

[v1.60/15]

[include atwork.config]

;; (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: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/)

[ezsteps]
cleantop $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -remove-runs -target ubuntu/nfs/none -runname release_toplevel -testpatt %
runall   $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt %            -target ubuntu/nfs/none -runname release_toplevel -runwait
runtop   $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt all_toplevel -target ubuntu/nfs/none -runname release_toplevel -rerun FAIL -preclean -runwait
results  $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs release_toplevel -target ubuntu/nfs/none -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

# test2 from the tests/Makefile

[var]
tname itemwait

[pre-launch-env-vars]
NUMTESTS 20

[ezsteps]

# Set things up
clean      $MTRUNNER $MTTESTDIR/fdktestqa/testqa $MTPATH megatest -remove-runs -testpatt % -target  %/% -runname #{get var tname}%
runbigrun3 $MTRUNNER $MTTESTDIR/fdktestqa/testqa $MTPATH nbfake megatest -run     -testpatt bigrun3 -target a/bigrun3 -runname #{get var tname}
# watchrun watches until it sees at least one RUNNING in bigrun and one PASS in bigrun2
watchrun   sleep 15;watchrun.sh #{get var tname}

[requirements]
# waiton  #{getenv ALL_TOPLEVEL_TESTS}

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


# test2 : fullprep

#!/bin/bash

runname=$1

pass=no
alldone=no
while [[ $alldone == no ]];do
    sleep 5
    $MTRUNNER $MTTESTDIR/fdktestqa/testqa $MTPATH megatest -list-runs $runname > list-runs.log
    bigrun_running=$(cat list-runs.log | egrep 'bigrun\(.*RUNNING'|wc -l)
    bigrun2_pass=$(cat list-runs.log   | egrep 'bigrun2.*COMPLETED.*PASS'|wc -l)
    echo "bigrun_running=$bigrun_running, bigrun2_pass=$bigrun2_pass"
    if [[ $bigrun_running -gt 0 ]] && [[ $bigrun2_pass -gt 0 ]];then
	pass=yes
	alldone=yes
    fi
    if [[ $bigrun_running -eq 0 ]];then
	echo "bigrun all done and no bigrun2 found with PASS."
	alldone=yes
    fi
done

if [[ $pass == yes ]];then
    echo PASS
    exit 0
else
    echo FAIL
    exit 1
fi

;; (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: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/)

;; (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"	        5  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: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  "Toplevel will be NOT_STARTED"        #/Test: runfirst\s+State: (INCOMPLETE|NOT_STARTED)/)
(expect:required in logbody =  1  "runfirst/b/2 will be NOT_STARTED/INCOMPLETE" #/Test: runfirst.b.2.\s+State: NOT_STARTED\s+Status: INCOMPLETE/)
;; (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/)

# test2 from the tests/Makefile

[var]
tname rollup

[ezsteps]

# Set things up
clean    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -remove-runs -testpatt %                    -target  ubuntu/nfs/none -runname #{get var tname}%
runfirst $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -runtests runfirst/% -reqtarg ubuntu/nfs/none -runname #{get var tname}   -preclean
firstres $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -list-runs #{get var tname}   -target ubuntu/nfs/none

# Set one test item to INCOMPLETE
setstate $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -set-state-status INCOMPLETE,FAIL :state COMPLETED :status PASS -testpatt runfirst/b/2 -target ubuntu/nfs/none -runname #{get var tname}

# Rerun a different test item
rerun    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -run         -testpatt  runfirst/spring     -reqtarg ubuntu/nfs/none -runname #{get var tname} -preclean -rerun PASS

results  $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname} -target ubuntu/nfs/none

[requirements]
# waiton  #{getenv ALL_TOPLEVEL_TESTS}

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


# test2 : fullprep

;; (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"	        2  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: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/)

;; (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"	        2  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: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/)

;; (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"	        2  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: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/)

# test2 from the tests/Makefile

[var]
tname test2
mtpath #{shell readlink -f ../../bin}

[ezsteps]
clean    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -remove-runs -testpatt %                    -target  ubuntu/nfs/none -runname #{get var tname}%
part1    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -run         -testpatt ez_pass,runfirst/a/% -reqtarg ubuntu/nfs/none -runname #{get var tname}   -preclean
part2    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -run         -testpatt  %/,%/ai             -reqtarg ubuntu/nfs/none -runname #{get var tname}_a -preclean
part3    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -runtests %/,%/ai                           -reqtarg ubuntu/nfs/none -runname #{get var tname}_b -preclean
part4    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -run         -testpatt  runfirst/%,%/ai     -reqtarg ubuntu/nfs/none -runname #{get var tname}_a -preclean
part5    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -run         -testpatt %/,%/winter          -reqtarg ubuntu/nfs/none -runname #{get var tname}_a -preclean
part6    $MTRUNNER $MTTESTDIR/fullrun  $MTPATH megatest -set-state-status COMPLETED,FORCED :state COMPLETED :status PASS -testpatt ez_p%s,runfirst/ -target ubuntu/nfs/none -runname #{get var tname}

results   $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname}   -target ubuntu/nfs/none
results_a $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname}_a -target ubuntu/nfs/none
results_b $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname}_b -target ubuntu/nfs/none

[requirements]
# waiton  #{getenv ALL_TOPLEVEL_TESTS}

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


# test2 : fullprep