Megatest

	    ;; TESTS
	    ((test-set-state-status-by-id)     (apply db:test-set-state-status-by-id dbstruct params))
	    ((delete-test-records)             (apply db:delete-test-records dbstruct params))
	    ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
	    ((test-set-status-state)           (apply db:test-set-status-state dbstruct params))
	    ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
	    ((roll-up-pass-fail-counts)        (apply db:roll-up-pass-fail-counts dbstruct params))
	    ;; ((update-pass-fail-counts)         (apply db:general-call dbstruct 'update-pass-fail-counts params))
	    ((top-test-set-per-pf-counts)      (apply db:top-test-set-per-pf-counts dbstruct params))
	    ((test-set-archive-block-id)       (apply db:test-set-archive-block-id dbstruct params))

	    ;; RUNS
	    ((register-run)                 (apply db:register-run dbstruct params))
	    ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
	    ((delete-run)                   (apply db:delete-run dbstruct params))

	   (list
	    ;; NOTE: Yes, the host can change!
	    (store-label "HostName"
			 (iup:label ;; (sdb:qry 'getstr 
			  (db:test-get-host testdat) ;; )
			  #:expand "HORIZONTAL")
			 (lambda (testdat)(db:test-get-host testdat)))




	    (store-label "DiskFree"
			 (iup:label (conc (db:test-get-diskfree testdat)) #:expand "HORIZONTAL")
			 (lambda (testdat)(conc (db:test-get-diskfree testdat))))
	    (store-label "CPULoad"
			 (iup:label (conc (db:test-get-cpuload testdat)) #:expand "HORIZONTAL")
			 (lambda (testdat)(conc (db:test-get-cpuload testdat))))
	    (store-label "RunDuration"
			 (iup:label (conc (seconds->hr-min-sec (db:test-get-run_duration testdat))) #:expand "HORIZONTAL")
			 (lambda (testdat)(conc (seconds->hr-min-sec (db:test-get-run_duration testdat)))))
	    (store-label "LogFile"
			 (iup:label (conc (db:test-get-final_logf testdat)) #:expand "HORIZONTAL")
			 (lambda (testdat)(conc (db:test-get-final_logf testdat))))
	    (store-label "ProcessId"
			 (iup:label (conc (db:test-get-process_id testdat)) #:expand "HORIZONTAL")
			 (lambda (testdat)(conc (db:test-get-process_id testdat))))
	    (store-label "Uname"
			 (iup:label "                                                   " #:expand "HORIZONTAL") ;;  #:wordwrap "YES")
			 (lambda (testdat) ;; (sdb:qry 'getstr 
			   (db:test-get-uname testdat))) ;; )
	    )))))

;; if there is a submegatest create a button to launch dashboard in that area
;;
(define (submegatest-panel dbstruct keydat testdat runname testconfig)
  (let* ((subarea (configf:lookup testconfig "setup" "submegatest"))
	 (area-exists (and subarea (file-exists? subarea))))
    (debug:print-info 0 "Megatest subarea=" subarea ", area-exists=" area-exists)
    (if subarea
	(iup:frame 
	 #:title "Megatest Run Info" ; #:expand "YES"
	 (iup:button
	  "Launch Dashboard"
	  #:action (lambda (obj)
		     (system (conc "cd " subarea ";env -i PATH=$PATH DISPLAY=$DISPLAY HOME=$HOME USER=$USER dashboard &")))))
	(iup:vbox))))

;; use a global for setting the buttons colors
;;                           state status teststeps
(define *state-status* (vector #f #f #f))
(define (update-state-status-buttons testdat)
  (let* ((state  (db:test-get-state  testdat))
	 (status (db:test-get-status testdat))

	 (last-update   0) ;; (current-seconds))
	 (request-update #t))
    (if (not testdat)
	(begin
	  (debug:print 2 "ERROR: No test data found for test " test-id ", exiting")
	  (exit 1))
	(let* (;; (run-id        (if testdat (db:test-get-run_id testdat) #f))
	       (test-registry (tests:get-all))
	       (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 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 
	       (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"))
	       ;; (tests:get-testconfig testdat testname 'return-procs))
	       (testmeta      (if testdat 
				  (let ((tm (db:testmeta-get-record dbstruct testname)))
				    (if tm tm (make-db:testmeta)))
				  (make-db:testmeta)))

	       (keystring  (string-intersperse 
			    (map (lambda (keyval)
				   ;; (conc ":" (car keyval) " " (cadr keyval)))
				   (cadr keyval))
				 keydat)
			    "/"))
	       (item-path  (db:test-get-item-path testdat))
	       ;; this next block was added to fix a bug where variables were
               ;; needed. Revisit this.
	       (runconfig  (let ((runconfigf (conc  *toppath* "/runconfigs.config")))
	 		     (if (file-exists? runconfigf)
	 			 (handle-exceptions
                                   exn
                                   #f  ;; do nothing, just keep on trucking ....
                                   (setup-env-defaults runconfigf run-id (make-hash-table) keydat environ-patt: keystring))
	 			 (make-hash-table))))
	       (testconfig    (begin
				;; (runs:set-megatest-env-vars run-id inrunname: runname testname: test-name itempath: item-path)
				(runs:set-megatest-env-vars run-id inkeyvals: keydat inrunname: runname intarget: keystring testname: testname itempath: item-path) ;; these may be needed by the launching process
				(handle-exceptions
				 exn
				 #f
				 (tests:get-testconfig (db:test-get-testname testdat) test-registry #t))))
	       (viewlog    (lambda (x)
			     (if (file-exists? logfile)
					;(system (conc "firefox " logfile "&"))
				 (dashboard-tests:run-html-viewer logfile)
				 (message-window (conc "File " logfile " not found")))))
	       (view-a-log (lambda (lfile) 
			     (let ((lfilename (conc rundir "/" lfile)))

			       command-text-box "VALUE"
			       (conc "megatest -remove-runs -target " keystring " -runname " runname
				     " -testpatt " (conc testname "/" (if (equal? item-path "")
									  "%"
									  item-path))
				     " -v"))))
	       (clean-run-execute  (lambda (x)
				     (let ((cmd (conc "bmegatest -remove-runs -target " keystring " -runname " runname
						      " -testpatt " (conc testname "/" (if (equal? item-path "")
											   "%"
											   item-path))
						      ";megatest -target " keystring " -runname " runname 
						      " -runtests " (conc testname "/" (if (equal? item-path "")
											   "%" 
											   item-path))

			      #:title testfullname
			      (iup:vbox ; #:expand "YES"
			       ;; The run and test info
			       (iup:hbox  ; #:expand "YES"
				(run-info-panel dbstruct keydat testdat runname)
				(test-info-panel testdat store-label widgets)
				(test-meta-panel testmeta store-meta))
			       (iup:hbox
				(host-info-panel testdat store-label)
				(submegatest-panel dbstruct keydat testdat runname testconfig))
			       ;; The controls
			       (iup:frame #:title "Actions" 
					  (iup:vbox
					   (iup:hbox 
					    (iup:button "View Log"      #:action viewlog      #:size "80x")
					    (iup:button "Start Xterm"   #:action xterm        #:size "80x")
					    (iup:button "Run Test"      #:action run-test     #:size "80x")

;; register a test run with the db
;;
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;;  to extract info from the structure returned
;;
;; NOTE: THIS IS COMPLETELY UNFINISHED. IT GOES WITH rmt:get-get-paths-matching-keynames
;;
;; (define (db:get-run-ids-matching dbstruct keynames target res)
;; ;; (define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit) ;; test-name)
;;   (let* ((tmp      (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))
;; 	 (keystr   (car tmp))
;; 	 (header   (cadr tmp))
;; 	 (res     '())
;; 	 (key-patt "")
;; 	 (runwildtype (if (substring-index "%" runnamepatt) "like" "glob"))
;; 	 (qry-str  #f)
;; 	 (keyvals  (if targpatt (keys:target->keyval keys targpatt) '())))
;;     (for-each (lambda (keyval)
;; 		(let* ((key    (car keyval))
;; 		       (patt   (cadr keyval))
;; 		       (fulkey (conc ":" key))
;; 		       (wildtype (if (substring-index "%" patt) "like" "glob")))
;; 		  (if patt
;; 		      (set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'"))
;; 		      (begin
;; 			(debug:print 0 "ERROR: searching for runs with no pattern set for " fulkey)
;; 			(exit 6)))))
;; 	      keyvals)
;;     (set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt " ORDER BY event_time "
;; 			(if limit  (conc " LIMIT " limit)   "")
;; 			(if offset (conc " OFFSET " offset) "")
;; 			";"))
;;     (debug:print-info 4 "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
;;     (db:with-db dbstruct #f #f ;; reads db, does not write to it.
;; 		(lambda (db)
;; 		  (sqlite3:for-each-row
;; 		   (lambda (a . r)
;; 		     (set! res (cons (list->vector (cons a r)) res)))
;; 		   (db:get-db dbstruct #f)
;; 		   qry-str
;; 		   runnamepatt)))
;;     (vector header res)))

;; Get all targets from the db
;;
(define (db:get-targets dbstruct)
  (let* ((res       '())
	 (keys       (db:get-keys dbstruct))
	 (header     keys) ;; (map key:get-fieldname keys))

	     #f
	     (lambda (db)
	       (sqlite3:first-result
		db
		(conc "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND testname in ('"
		      (string-intersperse testnames "','")
		      "') AND NOT (uname = 'n/a' AND item_path='');")) ;; should this include the (uname = 'n/a' ...) ???
	       ))
	    0)))))
             ;; DEBUG FIXME - need to merge this v.155 query correctly   
             ;; AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?)
             ;; AND NOT (uname = 'n/a' AND item_path = '');"

;; done with run when:
;;   0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
(define (db:estimated-tests-remaining dbstruct run-id)

             (SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass') AS pass_count;"
     test-id test-id)
    ;; Now rollup the counts to the central megatest.db
    (db:general-call dbdat 'pass-fail-counts (list pass-count fail-count test-id))
    ;; if the test is not FAIL then set status based on the fail and pass counts.
    (db:general-call dbdat 'test_data-pf-rollup (list test-id test-id test-id test-id))))

;; NOT USED!?
;;
(define (db:csv->test-data dbstruct run-id test-id csvdata)
  (debug:print 4 "test-id " test-id ", csvdata: " csvdata)
  (let* ((dbdat   (db:get-db dbstruct run-id))
	 (db      (db:dbdat-get-db dbdat))
	 (csvlist (csv->list (make-csv-reader
			      (open-input-string csvdata)
			      '((strip-leading-whitespace? #t)

	 ;; look up expected,tol,units from previous best fit test if they are all either #f or ''
	 (debug:print 4 "BEFORE: category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment " type: " type)
	 
	 (if (and (or (not expected)(equal? expected ""))
		  (or (not tol)     (equal? expected ""))
		  (or (not units)   (equal? expected "")))
	     (let-values (((new-expected new-tol new-units)(tdb:get-prev-tol-for-test #f test-id category variable)))
			 (set! expected new-expected)
			 (set! tol      new-tol)
			 (set! units    new-units)))
	 
	 (debug:print 4 "AFTER:  category: " category " variable: " variable " value: " value 
		      ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment)
	 ;; calculate status if NOT specified

	;; select state,status,count(state) from tests where run_id=59 AND testname='runfirst' group by state,status;
	;;
	'(top-test-set-per-pf-counts "UPDATE tests
                       SET state=CASE 
                                   WHEN (SELECT count(id) FROM tests 
                                                WHERE testname=?
                                                     AND item_path != '' 
                                                     AND status NOT IN ('n/a')
                                                     AND state in ('NOT_STARTED')) > 0 THEN 'UNKNOWN'
                                   WHEN (SELECT count(id) FROM tests 
                                                WHERE testname=?
                                                     AND item_path != '' 
                                                     AND (status NOT IN ('TEN_STRIKES','BLOCKED') OR status IN ('INCOMPLETE'))
                                                     AND state in ('RUNNING','NOT_STARTED','LAUNCHED','REMOTEHOSTSTART')) > 0 THEN 'RUNNING'
                                   WHEN (SELECT count(id) FROM tests 
                                                WHERE testname=?
                                                     AND item_path != '' 
                                                     AND state NOT IN ('COMPLETED','DELETED')) = 0 THEN 'COMPLETED'
                                   WHEN (SELECT count(id) FROM tests 
                                                WHERE testname=?
                                                     AND item_path != '' 
                                                     AND state = 'NOT_STARTED') > 0 THEN 'NOT_STARTED'
                                   ELSE 'UNKNOWN' END,
                            status=CASE 
                                  WHEN fail_count > 0 THEN 'FAIL' 

;;
;; Run this remotely!!
;;
(define (db:get-matching-previous-test-run-records dbstruct run-id test-name item-path)
  (let* ((dbdat   (db:get-db dbstruct #f))
	 (db      (db:dbdat-get-db dbdat))
	 (keys    (db:get-keys db))
	 (selstr  (string-intersperse keys ","))
	 (qrystr  (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND "))
	 (keyvals #f)
	 (tests-hash (make-hash-table)))
    ;; first look up the key values from the run selected by run-id
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (lambda (a . b)
       (set! keyvals (cons a b)))

	  ;; collect all matching tests for the runs then
	  ;; extract the most recent test and return that.
	  (debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals 
		       ", previous run ids found: " prev-run-ids)
	  (if (null? prev-run-ids) '()  ;; no previous runs? return null
	      (let loop ((hed (car prev-run-ids))
			 (tal (cdr prev-run-ids)))
		(let ((results (db:get-tests-for-run dbstruct hed (conc test-name "/" item-path) '() '() #f #f #f #f #f #f)))
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name 
			       ", item-path " item-path " results: " (intersperse results "\n"))
		  ;; Keep only the youngest of any test/item combination
		  (for-each 
		   (lambda (testdat)
		     (let* ((full-testname (conc (db:test-get-testname testdat) "/" (db:test-get-item-path testdat)))
			    (stored-test   (hash-table-ref/default tests-hash full-testname #f)))

;; M I S C   M A N A G E M E N T   I T E M S 
;;======================================================================

;; A routine to map itempaths using a itemmap
(define (db:compare-itempaths patha pathb itemmap)
  (debug:print-info 6 "ITEMMAP is " itemmap)
  (if itemmap
      (let ((pathb-mapped (db:multi-pattern-apply pathb itemmap)))
	(debug:print-info 6 "ITEMMAP is " itemmap ", path: " pathb ", mapped path: " pathb-mapped)
	(equal? patha pathb-mapped))
      (equal? patha pathb)))

;; (let* ((mapparts    (string-split itemmap))
;; 	     (pattern     (car mapparts))
;; 	     (replacement (if (> (length mapparts) 1) (cadr mapparts) "")))
;; 	(if replacement
;; 	    (equal? (string-substitute pattern replacement patha)
;; 		    (string-substitute pattern replacement pathb))
;; 	    (equal? (string-substitute pattern "" patha)
;; 		    (string-substitute pattern "" pathb))))

;; A routine to convert test/itempath using a itemmap
;; NOTE: to process only an itempath (i.e. no prepended testname)
;;       just call db:multi-pattern-apply
;;
(define (db:convert-test-itempath path-in itemmap)
  (debug:print-info 6 "ITEMMAP is " itemmap)
  (let* ((path-parts  (string-split path-in "/"))
	 (test-name   (if (null? path-parts) "" (car path-parts)))
	 (item-path   (string-intersperse (if (null? path-parts) '() (cdr path-parts)) "/")))
    (conc test-name "/" 
	  (db:multi-pattern-apply item-path itemmap))))

		(let* ((state             (db:test-get-state test))
		       (status            (db:test-get-status test))
		       (item-path         (db:test-get-item-path test))
		       (is-completed      (equal? state "COMPLETED"))
		       (is-running        (equal? state "RUNNING"))
		       (is-killed         (equal? state "KILLED"))
		       (is-ok             (member status '("PASS" "WARN" "CHECK" "WAIVED" "SKIP")))
		       (same-itempath     (db:compare-itempaths item-path ref-item-path itemmap))) ;; (equal? ref-item-path item-path)))
		  (set! ever-seen #t)
		  (cond
		   ;; case 1, non-item (parent test) is 
		   ((and (equal? item-path "") ;; this is the parent test of the waiton being examined
			 is-completed
			 (or is-ok (not (null? (lset-intersection eq? mode '(toplevel)))))) ;;  itemmatch itemwait))))))
		    (set! parent-waiton-met #t))

# design_spec.html : $(SRCFILES) $(CSVFILES)
#         asciidoc -b html5 -a icons -a iconsdir=$(DISPATH)/images/icons -a toc2 design_spec.txt
#

all : server.ps megatest_manual.html client.ps

megatest_manual.html : megatest_manual.txt getting_started.txt writing_tests.txt reference.txt ../plan.txt howto.txt *png
	asciidoc  -b html5 -a icons -a iconsdir=$(DISPATH)/images/icons -a toc2 megatest_manual.txt
#	dos2unix megatest_manual.html

server.ps : server.dot
	dot -Tps server.dot > server.ps

client.ps : client.dot

digraph G {

    // put client after server so server_start node is visible
    //
    subgraph cluster_2 {
        node [style=filled,shape=box];
	
	"test1"                  -> test2;
	runremote_lookup_server  -> login_attempt [label="have server"];
	runremote_lookup_server  -> monitordb_lookup_server [label="no server"];

	monitordb_lookup_server  -> login_attempt [label="have server"];
	monitordb_lookup_server  -> server_start_remote [label="no server"];

	server_start_remote      -> delay_2_sec;
	delay_2_sec              -> runremote_lookup_server;

	login_attempt            -> "rmt:send-receive_start" [label="login sucessful"];
	"rmt:send-receive_start" -> "rmt:send-receive_start";

	"rmt:send-receive_start" -> runremote_lookup_server [label=exception];
	login_attempt            -> clear_runremote [label="login failed"];

	"remove_running > 5s"    -> runremote_lookup_server;

	subgraph cluster_3 {
		node [style=filled];
		clear_runremote          -> "remove_running > 5s";
	}

        label = "client:setup";
        color=green;
    }

}

#FIG 3.2  Produced by xfig version 3.2.5c
Landscape
Center
Metric
A4      
100.00
Single
-2
1200 2
0 32 #c6b797
0 33 #eff8ff
0 34 #dccba6
0 35 #404040
0 36 #808080
0 37 #c0c0c0
0 38 #e0e0e0
0 39 #8e8f8e
0 40 #aaaaaa
0 41 #555555
0 42 #c7c3c7
0 43 #565151
0 44 #8e8e8e
0 45 #d7d7d7
0 46 #85807d
0 47 #d2d2d2
0 48 #3a3a3a
0 49 #4573aa
0 50 #aeaeae
0 51 #7b79a5
0 52 #444444
0 53 #73758c
0 54 #f7f7f7
0 55 #414541
0 56 #635dce
0 57 #bebebe
0 58 #515151
0 59 #e7e3e7
0 60 #000049
0 61 #797979
0 62 #303430
0 63 #414141
0 64 #c7b696
6 3600 2700 4455 3555
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 3600 2700 4050 2700 4050 3150 3600 3150 3600 2700
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 3690 3150 3690 3285 4185 3285 4185 2790 4050 2790
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 3825 3285 3825 3420 4320 3420 4320 2925 4185 2925
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 3960 3420 3960 3555 4455 3555 4455 3060 4320 3060
-6
6 1845 4500 2700 5355
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 1845 4500 2295 4500 2295 4950 1845 4950 1845 4500
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 1935 4950 1935 5085 2430 5085 2430 4590 2295 4590
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 2070 5085 2070 5220 2565 5220 2565 4725 2430 4725
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 2205 5220 2205 5355 2700 5355 2700 4860 2565 4860
-6
6 1800 900 2655 1755
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 1800 900 2250 900 2250 1350 1800 1350 1800 900
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 1890 1350 1890 1485 2385 1485 2385 990 2250 990
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 2025 1485 2025 1620 2520 1620 2520 1125 2385 1125
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 2160 1620 2160 1755 2655 1755 2655 1260 2520 1260
-6
6 5400 900 6255 1755
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 5400 900 5850 900 5850 1350 5400 1350 5400 900
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 5490 1350 5490 1485 5985 1485 5985 990 5850 990
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 5625 1485 5625 1620 6120 1620 6120 1125 5985 1125
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 5760 1620 5760 1755 6255 1755 6255 1260 6120 1260
-6
6 5400 4500 6255 5355
2 2 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 5400 4500 5850 4500 5850 4950 5400 4950 5400 4500
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 5490 4950 5490 5085 5985 5085 5985 4590 5850 4590
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 5625 5085 5625 5220 6120 5220 6120 4725 5985 4725
2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 5760 5220 5760 5355 6255 5355 6255 4860 6120 4860
-6
2 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
	0 0 1.00 60.00 120.00
	 5355 4455 4500 3600
2 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
	0 0 1.00 60.00 120.00
	 5400 1800 4500 2700
2 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
	0 0 1.00 60.00 120.00
	 3600 3600 2700 4500
2 1 0 2 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
	0 0 1.00 60.00 120.00
	 3510 2610 2790 1890
2 2 0 2 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 1530 675 3060 675 3060 5580 1530 5580 1530 675
2 2 0 2 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 3195 675 4815 675 4815 5580 3195 5580 3195 675
2 2 0 2 0 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 4950 675 6660 675 6660 5580 4950 5580 4950 675
2 2 0 2 7 7 50 -1 -1 0.000 0 0 -1 0 0 5
	 0 45 8550 45 8550 7245 0 7245 0 45
2 1 0 2 23 7 50 -1 -1 0.000 0 0 -1 1 0 3
	0 0 1.00 60.00 120.00
	 5040 6300 4050 5175 4050 3690
2 1 0 2 23 7 50 -1 -1 0.000 0 0 -1 1 0 3
	0 0 1.00 60.00 120.00
	 1080 5850 1080 2115 1755 1530
4 0 0 50 -1 0 16 0.0000 4 135 360 1935 4725 TstB\001
4 0 0 50 -1 0 16 0.0000 4 135 360 5445 1170 TstC\001
4 0 0 50 -1 0 16 0.0000 4 135 360 5445 4770 TstD\001
4 0 0 50 -1 0 16 0.0000 4 135 360 3600 2970 TstE\001
4 0 0 50 -1 0 16 0.0000 4 135 360 1845 1170 TstA\001
4 0 0 50 -1 0 16 0.0000 4 180 1260 900 6210 [requirements]\001
4 0 0 50 -1 0 16 0.0000 4 135 990 900 6405 waiton TstE\001
4 0 0 50 -1 0 16 0.0000 4 180 2070 900 6600 itemap foo/(\\d+) \\1/bar\001
4 0 0 50 -1 0 16 0.0000 4 180 810 5220 6165 [itemmap]\001
4 0 0 50 -1 0 16 0.0000 4 150 1260 5220 6360 TstC  .*/ foo/\001
4 0 0 50 -1 0 16 0.0000 4 165 1080 5220 6555 TstD ab/ xy/\001

<div class="listingblock">
<div class="title">In megatest.config</div>
<div class="content monospaced">
<pre>[setup]
reruns 5</pre>
</div></div>
</div>
<div class="sect3">
<h4 id="_run_time_limit">Run time limit</h4>
<div class="listingblock">
<div class="content monospaced">
<pre>[setup]
runtimelim 1h 2m 3s  # this will automatically kill the test if it runs for more than 1h 2m and 3s</pre>
</div></div>
</div>
</div>
</div>
</div>
<div class="sect1">
<h2 id="_the_testconfig_file">The testconfig File</h2>
<div class="sectionbody">
<div class="sect2">

#
# ## Example
# ## Remove everything up to the last /
itemmap .*/
#
# ## Example
# ## Replace foo/ with bar/
itemmap foo/ bar/

# multi-line; matches are applied in the listed order
# The following would map:
#   a123b321 to b321fooa123 then to 321fooa123p
#
itemmap (a\d+)(b\d+) \2foo\1
  b(.*) \1p</pre>
</div></div>
</div>
<div class="sect3">
<h4 id="_complex_mappings">Complex mappings</h4>
<div class="paragraph"><p>Complex mappings can be handled with the [itemmap] section</p></div>
<div class="imageblock">
<div class="content">
<img src="itemmap.png" alt="itemmap.png">
</div>
</div>
<div class="listingblock">
<div class="title">Autogeneration waiton list for dynamic flow dependency trees</div>
<div class="content monospaced">
<pre>[requirements]
# With a toplevel test you may wish to generate your list
# of tests to run dynamically
#
# waiton #{shell get-valid-tests-to-run.sh}</pre>
</div></div>
</div>
<div class="sect3">
<h4 id="_run_time_limit_2">Run time limit</h4>
<div class="listingblock">
<div class="content monospaced">
<pre>runtimelim 1h 2m 3s  # this will automatically kill the test if it runs for more than 1h 2m and 3s</pre>
</div></div>
</div>
<div class="sect3">
<h4 id="_skip">Skip</h4>

</div>
</div>
<div id="footnotes"><hr></div>
<div id="footer">
<div id="footer-text">
Version 1.0<br>
Last updated
 2015-09-10 21:54:17 MST
</div>
</div>
</body>
</html>

.In megatest.config
------------------
[setup]
reruns 5
------------------

Run time limit
^^^^^^^^^^^^^^

-----------------
[setup]
runtimelim 1h 2m 3s  # this will automatically kill the test if it runs for more than 1h 2m and 3s
-----------------

The testconfig File
-------------------

Setup section
~~~~~~~~~~~~~

Header

# ## Example
# ## Remove everything up to the last /
itemmap .*/
#
# ## Example
# ## Replace foo/ with bar/
itemmap foo/ bar/

# multi-line; matches are applied in the listed order
# The following would map:
#   a123b321 to b321fooa123 then to 321fooa123p
#
itemmap (a\d+)(b\d+) \2foo\1
  b(.*) \1p
-------------------

Complex mappings
^^^^^^^^^^^^^^^^

Complex mappings can be handled with the [itemmap] section

image::itemmap.png[]

.Complex mapping from 
.Autogeneration waiton list for dynamic flow dependency trees
-------------------
[requirements]
# With a toplevel test you may wish to generate your list 
# of tests to run dynamically
#
# waiton #{shell get-valid-tests-to-run.sh}

					    new-state
					    new-status
					    (args:get-arg "-m") #f)
		    ;; need to update the top test record if PASS or FAIL and this is a subtest
		    ;; NO NEED TO CALL roll-up-pass-fail-counts HERE, THIS IS DONE IN roll-up-pass-fail-counts called by tests:test-set-status!
		    ))
	      ;; for automated creation of the rollup html file this is a good place...
	      (if (not (equal? item-path ""))

		  (tests:summarize-items run-id test-id test-name #f))
	      (tests:summarize-test run-id test-id)  ;; don't force - just update if no
	      )
	    (mutex-unlock! m)
	    (debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area " 
			 work-area ":\n====\n exit code " (vector-ref exit-info 2) "\n" "====\n")
	    (if (not (vector-ref exit-info 1))
		(exit 4)))))))

				      (list 'env-ovrd  (hash-table-ref/default *configdat* "env-override" '())) 
				      (list 'set-vars  (if params (hash-table-ref/default params "-setvars" #f)))
				      (list 'runname   runname)
				      (list 'mt-bindir-path mt-bindir-path))))))))

    ;; clean out step records from previous run if they exist
    ;; (rmt:delete-test-step-records run-id test-id)
    ;; if the dir does not exist we may have a itempath where individual variables are a path, launch anyway
    (if (file-exists? work-area)
	(change-directory work-area)) ;; so that log files from the launch process don't clutter the test dir
    
    ;; Moving launch logs to MT_RUN_AREA_HOME/logs 
    ;;
    (let ((launchdir (configf:lookup *configdat* "setup" "launchdir"))) ;; (change-directory work-area) ;; so that log files from the launch process don't clutter the test dir
      (if (not launchdir) ;; default
	  (change-directory (conc *toppath* "/logs")) ;; can assume this exists
	  (case (string->symbol launchdir)

Launching and managing runs
  -runall                 : run all tests or as specified by -testpatt
  -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)
  -rerun-clean            : set all tests not COMPLETED+PASS,WARN,WAIVED to NOT_STARTED,n/a
                            and then run the specified testpatt with -preclean
  -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
  -get-run-status         : gets status for run specified by target and runname
  -run-wait               : wait on run specified by target and runname
  -preclean               : remove the existing test directory before running the test

		        "-test-status"
			"-set-values"
			"-load-test-data"
			"-summarize-items"
		        "-gui"
			"-daemonize"
			"-preclean"
			"-rerun-clean"

			;; misc
			"-repl"
			"-lock"
			"-unlock"
			"-list-servers"
                        "-run-wait"      ;; wait on a run to complete (i.e. no RUNNING)

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

;; run all tests are are Not COMPLETED and PASS or CHECK
(if (or (args:get-arg "-runall")
	(args:get-arg "-run")
	(args:get-arg "-rerun-clean")
	(args:get-arg "-runtests"))
    (general-run-call 
     "-runall"
     "run all tests"
     (lambda (target runname keys keyvals)
       (if (args:get-arg "-rerun-clean") ;; first set states/statuses correct
	   (let ((states   (or (configf:lookup *configdat* "validvalues" "cleanrerun-states")
			       "KILLREQ,KILLED,UNKNOWN,INCOMPLETE,STUCK,NOT_STARTED"))
		 (statuses (or (configf:lookup *configdat* "validvalues" "cleanrerun-statuses")
			       "FAIL,INCOMPLETE,ABORT")))
	     (hash-table-set! args:arg-hash "-preclean" #t)
	     (runs:operate-on 'set-state-status
			      target
			      (common:args-get-runname)  ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
			      "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
			      state:  states
			      ;; status: statuses
			      new-state-status: "NOT_STARTED,n/a")
	     (runs:operate-on 'set-state-status
			      target
			      (common:args-get-runname)  ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
			      "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
			      ;; state:  states
			      status: statuses
			      new-state-status: "NOT_STARTED,n/a")))
       (runs:run-tests target
		       runname
		       #f ;; (common:args-get-testpatt #f)
		       ;; (or (args:get-arg "-testpatt")
		       ;;     "%")
		       user
		       args:arg-hash))))

			  (cons testn res)))))))))

;;======================================================================
;;  T R I G G E R S
;;======================================================================

(define (mt:process-triggers run-id test-id newstate newstatus)
  (let* ((test-dat      (rmt:get-test-info-by-id run-id test-id)))
    (if test-dat
	(let* ((test-rundir   ;; (rmt:sdb-qry 'getstr ;; (filedb:get-path *fdb*
		(db:test-get-rundir test-dat)) ;; ) ;; )
	       (test-name     (db:test-get-testname test-dat))
	       (tconfig       #f)
	       (state         (if newstate  newstate  (db:test-get-state  test-dat)))
	       (status        (if newstatus newstatus (db:test-get-status test-dat))))
	  (if (and test-rundir   ;; #f means no dir set yet
		   (file-exists? test-rundir)
		   (directory? test-rundir))
	      (call-with-environment-variables
	       (list (cons "MT_TEST_NAME" test-name)
		     (cons "MT_TEST_RUN_DIR" test-rundir)
		     (cons "MT_ITEMPATH"     (db:test-get-item-path test-dat)))
	       (lambda ()
		 (push-directory test-rundir)
		 (set! tconfig (mt:lazy-read-test-config test-name))
		 (for-each (lambda (trigger)
			     (let ((cmd  (configf:lookup tconfig "triggers" trigger))
				   (logf (conc  test-rundir "/last-trigger.log")))
			       (if cmd
				   ;; Putting the commandline into ( )'s means no control over the shell. 
				   ;; stdout and stderr will be caught in the NBFAKE or mt_launch.log files
				   ;; or equivalent. No need to do this. Just run it?
				   (let ((fullcmd (conc cmd " " test-id " " test-rundir " " trigger "&")))
				     (debug:print-info 0 "TRIGGERED on " trigger ", running command " fullcmd)
				     (process-run fullcmd)))))
			   (list
			    (conc state "/" status)
			    (conc state "/")
			    (conc "/" status)))
		 (pop-directory))
	       ))))))

;;======================================================================
;;  S T A T E   A N D   S T A T U S   F O R   T E S T S 
;;======================================================================

;; speed up for common cases with a little logic
(define (mt:test-set-state-status-by-id run-id test-id newstate newstatus newcomment)

;; hand off a call to one of the db:queries statements
;; added run-id to make looking up the correct db possible 
;;
(define (rmt:general-call stmtname run-id . params)
  (rmt:send-receive 'general-call run-id (append (list stmtname run-id) params)))

;; (define (rmt:sync-inmem->db run-id)
;;   (rmt:send-receive 'sync-inmem->db run-id '()))

(define (rmt:sdb-qry qry val run-id)
  ;; add caching if qry is 'getid or 'getstr
  (rmt:send-receive 'sdb-qry run-id (list qry val)))

;; NOT COMPLETED
(define (rmt:runtests user run-id testpatt params)

(define (rmt:test-get-paths-matching-keynames-target-new keynames target res testpatt statepatt statuspatt runname)
  (let ((run-ids (rmt:get-run-ids-matching-target keynames target res runname testpatt statepatt statuspatt)))
    (apply append 
	   (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)))
	   run-ids))))

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

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

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

;; 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 state status)
  (rmt:send-receive 'roll-up-pass-fail-counts run-id (list run-id test-name item-path state status)))

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

(define (rmt:top-test-set-per-pf-counts run-id test-name)
  (rmt:send-receive 'top-test-set-per-pf-counts run-id (list run-id test-name)))

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

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

(define (rmt:delete-run run-id)
  (rmt:send-receive 'delete-run run-id (list run-id)))

(define (rmt:delete-old-deleted-test-records)
  (rmt:send-receive 'delete-old-deleted-test-records #f '()))




(define (rmt:get-runs runpatt count offset keypatts)
  (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts)))

(define (rmt:get-all-run-ids)
  (rmt:send-receive 'get-all-run-ids #f '()))

(define (rmt:get-prev-run-ids run-id)

;;======================================================================
;; read a config file, loading only the section pertinent
;; to this run field1val/field2val/field3val ...
;;======================================================================

(use format directory-utils)

(declare (unit runconfig))
(declare (uses common))

(include "common_records.scm")

;; NB// to process a runconfig ensure to use environ-patt with target!
;;
(define (setup-env-defaults fname run-id already-seen keyvals #!key (environ-patt #f)(change-env #t))
  (let* ((keys    (map car keyvals))
	 (thekey  (if keyvals 
		      (string-intersperse (map (lambda (x)(if x x "-na-")) (map cadr keyvals)) "/")
		      (or (common:args-get-target)
			  (get-environment-variable "MT_TARGET")
			  (begin
			    (debug:print 0 "ERROR: setup-env-defaults called with no run-id or -target or -reqtarg")
			    "nothing matches this I hope"))))
	 ;; Why was system disallowed in the reading of the runconfigs file?
	 ;; NOTE: Should be setting env vars based on (target|default)

		(for-each (lambda (varval)
			    (set! envdat (append envdat (list varval)))
			    (safe-setenv (car varval)(cadr varval)))
			  (configf:get-section runconfig section)))
	      (list "default" target))
    (vector target runname testpatt keys keyvals envdat mconfig runconfig serverdat transport db toppath run-id)))

(define (runs:set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f)(inkeyvals #f)(intarget #f)(testname #f)(itempath #f))
  (let* ((target    (or intarget 
			(common:args-get-target)
			(get-environment-variable "MT_TARGET")))
	 (keys      (if inkeys    inkeys    (rmt:get-keys)))
	 (keyvals   (if inkeyvals inkeyvals (keys:target->keyval keys target)))
	 (vals      (hash-table-ref/default *env-vars-by-run-id* run-id #f))
	 (link-tree (configf:lookup *configdat* "setup" "linktree")))
    (if testname (setenv "MT_TEST_NAME" testname))
    (if itempath (setenv "MT_ITEMPATH"  itempath))

    ;; get the info from the db and put it in the cache
    (if link-tree
	(setenv "MT_LINKTREE" link-tree)
	(debug:print 0 "ERROR: linktree not set, should be set in megatest.config in [setup] section."))
    (if (not vals)
	(let ((ht (make-hash-table)))
	  (hash-table-set! *env-vars-by-run-id* run-id ht)

    (if (not (get-environment-variable "MT_TARGET"))(setenv "MT_TARGET" target))
    (alist->env-vars (hash-table-ref/default *configdat* "env-override" '()))
    ;; Lets use this as an opportunity to put MT_RUNNAME in the environment
    (let ((runname  (if inrunname inrunname (rmt:get-run-name-from-id run-id))))
      (if runname
	  (setenv "MT_RUNNAME" runname)
	  (debug:print 0 "ERROR: no value for runname for id " run-id)))
    (setenv "MT_RUN_AREA_HOME" *toppath*)
    ;; if a testname and itempath are available set the remaining appropriate variables
    (if testname (setenv "MT_TEST_NAME" testname))
    (if itempath (setenv "MT_ITEMPATH"  itempath))
    (if (and testname link-tree)
	(setenv "MT_TEST_RUN_DIR" (conc (getenv "MT_LINKTREE")  "/"
					(getenv "MT_TARGET")    "/"
					(getenv "MT_RUNNAME")   "/"
					(getenv "MT_TEST_NAME")
					(if (and itempath
						 (not (equal? itempath "")))
					    (conc "/" itempath)
					    ""))))
    ))

(define (set-item-env-vars itemdat)
  (for-each (lambda (item)
	      (debug:print 2 "setenv " (car item) " " (cadr item))
	      (setenv (car item) (cadr item)))
	    itemdat))

	  (debug:print-info 0 "Have leftovers!")
	  (loop (car reg)(cdr reg) '() reruns))
	 (else
	  (debug:print-info 4 "Exiting loop with...\n  hed=" hed "\n  tal=" tal "\n  reruns=" reruns))
	 )))
    ;; now *if* -run-wait we wait for all tests to be done
    ;; Now wait for any RUNNING tests to complete (if in run-wait mode)
    (thread-sleep! 5) ;; I think there is a race condition here. Let states/statuses settle
    (let wait-loop ((num-running      (rmt:get-count-tests-running-for-run-id run-id))
		    (prev-num-running 0))
      ;; (debug:print 0 "num-running=" num-running ", prev-num-running=" prev-num-running)
      (if (and (or (args:get-arg "-run-wait")
		   (equal? (configf:lookup *configdat* "setup" "run-wait") "yes"))
	       (> num-running 0))
	  (begin

    (set! full-test-name (db:test-make-full-name test-name item-path))
    (debug:print-info 4
		      "\nTESTNAME: " full-test-name 
		      "\n   test-config: " (hash-table->alist test-conf)
		      "\n   itemdat: " itemdat
		      )
    (debug:print 2 "Attempting to launch test " full-test-name)
    ;; (setenv "MT_TEST_NAME" test-name) ;; 
    ;; (setenv "MT_ITEMPATH"  item-path)
    ;; (setenv "MT_RUNNAME"   runname)
    (runs:set-megatest-env-vars run-id inrunname: runname testname: test-name itempath: item-path) ;; these may be needed by the launching process
    (change-directory *toppath*)

    ;; Here is where the test_meta table is best updated
    ;; Yes, another use of a global for caching. Need a better way?
    ;;
    ;; There is now a single call to runs:update-all-test_meta and this 
    ;; per-test call is not needed. Given the delicacy of the move to 

;;
;;                                  test-a is waiting on test-b so we need to create a pattern for test-b given test-a and itemmap
(define (tests:extend-test-patts test-patt test-b test-a itemmap)
  (let* ((patts      (string-split test-patt ","))
	 (test-b-len (+ (string-length test-b) 1))
	 (patts-b    (map (lambda (x)
			    (let* ((modpatt (if itemmap (db:convert-test-itempath x itemmap) x)) 
				   (newpatt (conc test-a "/" (substring modpatt test-b-len (string-length modpatt)))))
				         ;; (conc test-a "/," test-a "/" (substring modpatt test-b-len (string-length modpatt)))))
			      ;; (print "in map, x=" x ", newpatt=" newpatt)
			      newpatt))
			  (filter (lambda (x)
				    (eq? (substring-index (conc test-b "/") x) 0))
				  patts))))
    (string-intersperse (delete-duplicates (append patts (if (null? patts-b)
							     (list (conc test-a "/%"))

;; 	       (tests:match test-patts testname #f))
;; 	     (map (lambda (testp)
;; 		    (last (string-split testp "/")))
;; 		  tests)))))


(define (tests:get-testconfig test-name test-registry system-allowed)
  (let* ((test-path         (hash-table-ref/default 
			     test-registry test-name 
			     (conc *toppath* "/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
											 "pre-launch-env-vars"
											 #f))
			   #f)))

;; Ignore initial errors
(trigger "ScriptStart" #/^Script started/)
(trigger "TestStart"   #/^megatest> \(/)
(section "startup"     "ScriptStart" "TestStart")

(expect:ignore in "startup" >= 0 "Ignore startup errors" #/error/i)

(expect:ignore in "LogFileBody" >= 0 "Ignore .so files with error in name" #/loading.*error.*\.so/)
; loading /usr/local/lib/chicken/7/type-errors.import.so ..
;; You should have at least one expect:required. This ensures that your process ran
(expect:required in "LogFileBody" > 0 "At least one PASS" #/\[.{0,4}PASS.{0,4}\]/)

;; You may need ignores to suppress false error or warning hits from the later expects
;; NOTE: Order is important here!
(expect:ignore   in "LogFileBody"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
(expect:warning  in "LogFileBody"  = 0 "Any warning" #/warn/)

(use sqlite3)

;;======================================================================
;; P R O C E S S E S
;;======================================================================

(test "cmd-run-with-stderr->list" '("No such file or directory")
      (let ((reslst (cmd-run-with-stderr->list "ls" "/tmp/ihadbetternotexist")))
	(string-search (regexp "No such file or directory")(car reslst))))

;; test:match->sqlqry
(test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname GLOB '' AND item_path LIKE 'b%')"
      (tests:match->sqlqry "a/b,a%,/b%"))
(test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname LIKE '%' AND item_path LIKE 'b%')"
      (tests:match->sqlqry "a/b,a%,%/b%"))

(let* ((cmd             "dunno")
      (run-id          1)
      (rid             1)
      (rawcmd          "dunno")
      (params          '())
      (duration        100)
      (connection-info (vector #f #f #f))
      (dat              "abc")
      (json-str         "\"def\"")
      (item-path        "a/b/c")
      (test-id          1)
      (testpatt         "%/a/%")
      (newstate         "COMPLETED")
      (newstatus        "PASS")
      (newcomment       "Stupid comment")
      (testnames        '("test1" "test2"))
      (currstate        "COMPLETED")
      (currstatus       "FAIL")
      (states           '("COMPLETED" "RUNNING"))
      (statuses         '("PASS" "FAIL"))
      (offset           100)
      (limit            10)
      (not-in           #t)
      (sort-by          #f)
      (sort-order       #f)
      (qryvals          #f)
      (qry              'a)
      (synckey          #f)
      (keynum           1)
      (run-ids          '(1 2 3))
      (state            "RUNNING")
      (status           "FAIL")
      (msg              "Sillyness")
      (test-name        "test184")
      (logf             "/tmp/a.logfile")
      (pid              1234567)
      (target           "a/b/c")
      (res              #f)
      (runname          "myfirstrun")
      (statepatt        "CO%")
      (statuspatt       "PA%")
      (keynames         '("SYSTEM" "RELEASE")) ;; "sysname" "fsname" "datapath"))
      (waitons          '("a" "b" "c"))
      (ref-item-path    "/d/e/f")
      (jobgroup         "anl")
      (runpatt          "run%")
      (keyvals          '(("SYSTEM" "a")("RELEASE" "b")))
      (keys             (map car keyvals))
      (user             "freddy")
      (owner            "tommy")
      (count            100)
      (keypatts         '(("SYSTEM" "%a")("RELEASE" "%b")))
      (lock             #f)
      (unlock           #t)
      (run-status       "n/a")
      (runnamepatt      "b%")
      (targpatt         "%a/%b")
      (fields           "id,runname")
      (ovr-deadtime     100)
      (teststep-name    "first")
      (state-in         "COMPLETED")
      (status-in        "FAIL")
      (comment          "This is a comment eh!")
      (logfile          "/tmp/alogfile.log")
      (categorypatt     "stats")
      (work-area        "/tmp")
      (fld              "owner")
      (val              5)
      (csvdata          "id,meas,val\n1,voltage,2")
      (action-patt      "%")
      (param-key        "dunno")
      (testname         "atest")
      (dneeded          10000)
      (bdisk-id         1)
      (archive-path     "tmp")
      (block-id         1)
      (testsuite-name   "fullrun")
      (areakey          "dunno")
      (bdisk-name       "what")
      (bdisk-path       "tmp")
      (df               1000000)
      (archive-block-id 1)
      (stmtname         'blah))
  (test #f #f (rmt:write-frequency-over-limit? cmd run-id))
  (test #f #f (rmt:get-connection-info run-id))
  (test #f #t (rmt:update-db-stats run-id rawcmd params duration))
  (test #f #t (begin (rmt:print-db-stats) #t))
  (test #f '(none . 0) (rmt:get-max-query-average run-id))
  (test #f #f (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params))
  (test #f "\"abc\"" (rmt:dat->json-str dat))
  (test #f "def" (rmt:json-str->dat json-str))
  (test #f #f (rmt:kill-server run-id))
  (test #f #t (begin (rmt:start-server run-id) #t))
  (test #f '(#f "Login failed due to mismatch run-id: " 1 ", " #f) (rmt:login run-id))
  (test #f #f (rmt:login-no-auto-client-setup connection-info run-id))
  (test #f #t (begin (rmt:runtests user run-id testpatt params) #t))
  (test #f '() (rmt:get-key-val-pairs run-id))
  (test #f '("SYSTEM" "RELEASE") (rmt:get-keys))
  (test #f '() (rmt:get-key-vals run-id))
  (test #f (vector '("SYSTEM" "RELEASE") '()) (rmt:get-targets))
  (test #f #t (rmt:register-test run-id test-name item-path))
  (test #f #f (rmt:get-test-id run-id testname item-path))
  (test #f #f (rmt:get-test-info-by-id run-id test-id))
  (test #f #f (rmt:test-get-rundir-from-test-id run-id test-id))
  (test #f #t (database? (rmt:open-test-db-by-test-id run-id test-id work-area: "/tmp")))
  (test #f #t (begin (rmt:set-tests-state-status run-id testnames currstate currstatus newstate newstatus) #t))
  (test #f '() (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)) ;;;
  (test #f #t (vector? (car (rmt:get-tests-for-runs-mindata run-ids testpatt states statuses not-in))))
  (test #f #t (begin (rmt:delete-test-records run-id test-id) #t))
  (test #f #t (begin (rmt:test-set-status-state run-id test-id status state msg) #t))  
  (test #f 1  (rmt:test-toplevel-num-items run-id test-name))
  (test #f '() (rmt:get-matching-previous-test-run-records run-id test-name item-path))
  (test #f #f (rmt:test-get-logfile-info run-id test-name))
  (test #f #t (vector? (car (rmt:test-get-records-for-index-file run-id test-name))))
  (test #f #f (rmt:get-testinfo-state-status run-id test-id))
  (test #f #t (rmt:test-set-log! run-id test-id logf))
  (test #f #t (begin (rmt:test-set-top-process-pid run-id test-id pid) #t))
  (test #f #f (rmt:test-get-top-process-pid run-id test-id))
  (test #f '() (rmt:get-run-ids-matching-target keynames target res runname testpatt statepatt statuspatt))
  (test #f '() (rmt:test-get-paths-matching-keynames-target-new keynames target res testpatt statepatt statuspatt runname))
  (test #f '("c" "b" "a") (rmt:get-prereqs-not-met run-id waitons ref-item-path)) ;;  #!key (mode '(normal))(itemmap #f)))
  (test #f 0  (rmt:get-count-tests-running-for-run-id run-id))
  (test #f 0  (rmt:get-count-tests-running run-id))
  (test #f 0  (rmt:get-count-tests-running-for-testname run-id testname))
  (test #f 0  (rmt:get-count-tests-running-in-jobgroup run-id jobgroup))
  (test #f #t (rmt:roll-up-pass-fail-counts run-id test-name item-path state status))
  (test #f #t (rmt:update-pass-fail-counts run-id test-name))
  (test #f #t (rmt:top-test-set-per-pf-counts run-id test-name))
  (test #f #t (vector? (rmt:get-run-info run-id)))
  (test #f 0  (rmt:get-num-runs runpatt))
  (test #f 1  (rmt:register-run keyvals runname state status user))
  (test #f "myfirstrun" (rmt:get-run-name-from-id run-id))
  (test #f #t (begin (rmt:delete-run run-id) #t))
  (test #f #t (begin (rmt:delete-old-deleted-test-records) #t))
  (test #f #t (vector? (rmt:get-runs runpatt count offset keypatts)))
  (test #f '() (rmt:get-all-run-ids))
  (test #f '() (rmt:get-prev-run-ids run-id))
  (test #f #t (begin (rmt:lock/unlock-run run-id lock unlock user) #t))
  (test #f #t (begin (rmt:set-run-status run-id "NONPASS" msg: msg) #t)) ;; run-status
  (test #f "NONPASS" (rmt:get-run-status run-id))
  (test #f #t (begin (rmt:update-run-event_time run-id) #t))
  (test #f (vector '("SYSTEM" "RELEASE" "id") '()) (rmt:get-runs-by-patt  keys runnamepatt targpatt offset limit '("id"))) ;; fields of #f uses default)
  (test #f #t (begin (rmt:find-and-mark-incomplete run-id ovr-deadtime) #t))
  (test #f #t (begin (rmt:find-and-mark-incomplete-all-runs ovr-deadtime: ovr-deadtime) #t))
  (test #f #f (rmt:get-previous-test-run-record run-id test-name item-path))
  (test #f #t (begin (rmt:teststep-set-status! run-id test-id teststep-name state-in status-in comment logfile) #t))
  (test #f #t (vector? (car (rmt:get-steps-for-test run-id test-id))))
  (test #f '() (rmt:read-test-data run-id test-id categorypatt work-area: work-area))
  (test #f #t (begin (rmt:testmeta-add-record testname) #t))
  (test #f (vector 1 "atest" "" "" "" "" "" "" "" "" "default") (rmt:testmeta-get-record testname))
  (test #f #t (begin (rmt:testmeta-update-field test-name fld val) #t))
  (test #f #t (rmt:test-data-rollup run-id test-id status))
  (test #f #t (begin (rmt:csv->test-data run-id test-id csvdata) #t))
  (test #f '() (rmt:tasks-find-task-queue-records target runname testpatt statepatt action-patt))
  (test #f #t (begin (rmt:tasks-add "action" owner target runname testpatt "params") #t))
  (test #f #t (begin (rmt:tasks-set-state-given-param-key param-key newstate) #t))
  (test #f #t (begin (rmt:test-set-state-status-by-id run-id test-id newstate newstatus newcomment) #t))
;; 
;; (test #f #f (rmt:archive-get-allocations  testname itempath dneeded))
;; (test #f #f (rmt:archive-register-block-name bdisk-id archive-path))
;; (test #f #f (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name areakey))
;; (test #f #f (rmt:archive-register-disk bdisk-name bdisk-path df))
;; (test #f #f (rmt:test-set-archive-block-id run-id test-id archive-block-id))
  ;; (test #f #f (rmt:test-get-archive-block-info archive-block-id))
  
  ;; Defer these a little while ...
  ;;
  ;; (test #f #f (rmt:synchash-get run-id proc synckey keynum params))
  ;; (test #f #f (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected)
  ;; (test #f #f (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5)))
  ;; (test #f #f (apply rmt:general-call stmtname run-id params))
  ;; (test #f #f (rmt:sync-inmem->db run-id))
  ;; (test #f #f (rmt:sdb-qry qry val run-id))

  ;; Deprecated or removed
  ;;
  ;; (test #f #f (rmt:get-run-ids-matching keynames target res))

  )

(exit)

(test "update-test_meta" "test1" (begin
				   (runs:update-test_meta "test1" tconfig)
				   (let ((dat (rmt:testmeta-get-record "test1")))
				     (vector-ref dat 1))))

(define test-path "tests/test1")
(define disk-path #f)
(test "get-best-disk"    #t (string? (file-exists? (let ((d (get-best-disk *configdat* #f)))
						     (set! disk-path d)
						     d))))
(test "create-work-area" #t (symbolic-link? (car (create-work-area 1 rinfo keyvals 1 test-path disk-path "test1" '()))))
(test #f "" (item-list->path '()))

;;======================================================================
;; Create a test with multiple items and verify that rollup logic works

(test "launch-test" #t
      (string? 
       (file-exists?
	;; (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat params)
	(launch-test 30001 1 rinfo keyvals "run1" tconfig "test1" test-path '() (make-hash-table)))))

;;======================================================================
;; M O R E   R E M O T E   C A L  L S
;;======================================================================

(test #f '("COMPLETED" "PASS")
      (begin
	(rmt:set-tests-state-status 1 '("rollup") "COMPLETED" "AUTO" "COMPLETED" "PASS")
	(get-state-status 1 "rollup" "")))
(test #f #t (rmt:top-test-set-per-pf-counts 1 "rollup"))

;;======================================================================
;; T E S T   I T E M M A P
;;======================================================================

(test #f "a/b/c"       (db:multi-pattern-apply   "d/e/f" "d a\ne b\nf c"))
(test #f "blah/foo/bar/baz" (db:convert-test-itempath "blah/baz/bar/foo" "^([^/]+)/([^/]+)/([^/]+)$ \\3/\\2/\\1"))
(test #f #t (db:compare-itempaths "abc/def/123" "abc/ghi/123" "ghi def"))
(test #f #f (db:compare-itempaths "some/5" "item/5" ".*/"))
(test #f #t (db:compare-itempaths "some/5" "item/5" ".*/ some/"))

(test #f '() (rmt:get-prereqs-not-met 1 '("rollup") "some/5" mode: '(toplevel)  itemmap: ".*/" "/"))
(test #f '() (rmt:get-prereqs-not-met 1 '("rollup") "some/5" mode: '(normal)    itemmap: ".*/" "/"))
(test #f '() (rmt:get-prereqs-not-met 1 '("rollup") "some/5" mode: '(itemmatch) itemmap: ".*/" "/"))
(test #f '() (rmt:get-prereqs-not-met 1 '("rollup") "some/5" mode: '(itemwait)  itemmap: ".*/" "/"))

(exit 1)




;; (test "Run a test" #t (general-run-call 

(print "Waiting for server to be done, should be about 20 seconds")
(test "server stop" #f (let ((hostname (car  *runremote*))
			     (port     (cadr *runremote*)))
			 (tasks:kill-server #t hostname port server-pid 'http)
			 (open-run-close tasks:get-best-server tasks:open-db)))







;; (cdb:kill-server *runremote*)

;; (thread-join! th1 th2 th3)

;; ADD ME!!!! (db:get-prereqs-not-met *db* 1 '("runfirst") "" mode: 'normal)
;; ADD ME!!!! (rdb:get-tests-for-run *db* 1 "runfirst" #f '() '())