Megatest

	      (if match ;; (and match (list? match)(> (length match) 1))
		  (cadr match)
		  #f))
	    ))
      #f))

(define configf:lookup config-lookup)
(define configf:read-file read-config)

(define (configf:section-vars cfgdat section)
  (let ((sectdat (hash-table-ref/default cfgdat section '())))
    (if (null? sectdat)
	'()
	(map car sectdat))))

    (with-output-to-file fname 
      (lambda ()
	(for-each 
	 (lambda (line)
	   (print line))
	 (configf:expand-multi-lines fdat))))))

;;======================================================================
;; refdb
;;======================================================================

;; reads a refdb into an assoc array of assoc arrays
;;   returns (list dat msg)
(define (configf:read-refdb refdb-path)
  (let ((sheets-file  (conc refdb-path "/sheet-names.cfg")))
    (if (not (file-exists? sheets-file))
	(list #f (conc "ERROR: no refdb found at " refdb-path))
	(if (not (file-read-access? sheets-file))
	    (list #f (conc "ERROR: refdb file not readable at " refdb-path))
	    (let* ((sheets (with-input-from-file sheets-file
			     (lambda ()
			       (let loop ((inl (read-line))
					  (res '()))
				 (if (eof-object? inl)
				     (reverse res)
				     (loop (read-line)(cons inl res)))))))
		   (data   '()))
	      (for-each 
	       (lambda (sheet-name)
		 (let* ((dat-path  (conc refdb-path "/" sheet-name ".dat"))
			(ref-dat   (configf:read-file dat-path #f #t))
			(ref-assoc (map (lambda (key)
					  (list key (hash-table-ref ref-dat key)))
					(hash-table-keys ref-dat))))
				   ;; (hash-table->alist ref-dat)))
		   (set! data (append data (list (list sheet-name ref-assoc))))))
	       sheets)
	      (list data "NO ERRORS"))))))

;; map over all pairs in a three level hierarchial alist and apply a function to the keys/val
;;
(define (configf:map-all-hier-alist data proc #!key (initproc1 #f)(initproc2 #f)(initproc3 #f))
  (for-each 
   (lambda (sheetname)
     (let* ((sheettmp  (assoc sheetname data))
	    (sheetdat  (if sheettmp (cadr sheettmp) '())))
       (if initproc1 (initproc1 sheetname))
       (for-each 
	(lambda (sectionname)
	  (let* ((sectiontmp  (assoc sectionname sheetdat))
		 (sectiondat  (if sectiontmp (cadr sectiontmp) '())))
	    (if initproc2 (initproc2 sheetname sectionname))
	    (for-each
	     (lambda (varname)
	       (let* ((valtmp (assoc varname sectiondat))
		      (val    (if valtmp (cadr valtmp) "")))
		 (proc sheetname sectionname varname val)))
	     (map car sectiondat))))
	(map car sheetdat))))
   (map car data)))

             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 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' 
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND status = 'SKIP') > 0 THEN 'SKIP'
                                  ELSE 'UNKNOWN' END

  -var varName            : for config and runconfig lookup value for sectionName varName

Misc 
  -start-dir path         : switch to this directory before running megatest
  -rebuild-db             : bring the database schema up to date
  -cleanup-db             : remove any orphan records, vacuum the db
  -update-meta            : update the tests metadata for all tests
  -env2file fname         : write the environment to fname.csh and fname.sh
  -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                 overwritten by values set in config files.
  -server -|hostname      : start the server (reduces contention on megatest.db), use
                            - to automatically figure out hostname
  -daemonize              : fork into background and disconnect from stdin/out
  -list-servers           : list the servers 
  -stop-server id         : stop server specified by id (see output of -list-servers), use
                            0 to kill all
  -repl                   : start a repl (useful for extending megatest)
  -load file.scm          : load and run file.scm
  -mark-incompletes       : find and mark incomplete tests
  -ping run-id|host:port  : ping server, exit with 0 if found

Utilities
  -env2file fname         : write the environment to fname.csh and fname.sh
  -refdb2dat refdb        : convert refdb to sexp or to format specified by -dumpmode
                            formats: perl, ruby, sqlite3
  -o                      : output file for refdb2dat (defaults to stdout)

Spreadsheet generation
  -extract-ods fname.ods  : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile
                            if it contains forward slashes the path will be converted
                            to windows style
Getting started

			"-test-files"  ;; -test-paths is for listing all
			"-load"        ;; load and exectute a scheme file
			"-section"
			"-var"
			"-dumpmode"
			"-run-id"
			"-ping"
			"-refdb2dat"
			"-o"
			) 
		 (list  "-h" "-help" "--help"
			"-version"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-show-keys"

	(map (lambda (x)
	       (string-intersperse 
		x
		" => "))
	     (common:get-disks) )
	"\n"))
      (set! *didsomething* #t)))

(if (args:get-arg "-refdb2dat")
    (let* ((input-db (args:get-arg "-refdb2dat"))
	   (out-file (args:get-arg "-o"))
	   (out-fmt  (or (args:get-arg "-dumpmode") "scheme"))
	   (out-port (if (and out-file 
			      (not (equal? out-fmt "sqlite3")))
			 (open-output-file out-file)
			 (current-output-port)))
	   (res-data (configf:read-refdb input-db))
	   (data     (car res-data))
	   (msg      (cadr res-data)))
      (if (not data)
	  (debug:print 0 data) ;; some error occurred
	  (with-output-to-port out-port
	    (lambda ()
	      (case (string->symbol out-fmt)
		((scheme)(pp data))
		((perl)
		 ;; (print "%hash = (")
		 ;;        key1 => 'value1',
		 ;;        key2 => 'value2',
		 ;;        key3 => 'value3',
		 ;; );
		 (configf:map-all-hier-alist 
		  data 
		  (lambda (sheetname sectionname varname val)
		    (print "$data{\"" sheetname "\"}{\"" sectionname "\"}{\"" varname "\"} = \"" val "\";"))))
		((python ruby)
		 (print "data={}")
		 (configf:map-all-hier-alist
		  data
		  (lambda (sheetname sectionname varname val)
		    (print "data[\"" sheetname "\"][\"" sectionname "\"][\"" varname "\"] = \"" val "\""))
		  initproc1:
		  (lambda (sheetname)
		    (print "data[\"" sheetname "\"] = {}"))
		  initproc2:
		  (lambda (sheetname sectionname)
		    (print "data[\"" sheetname "\"][\"" sectionname "\"] = {}"))))
		((sqlite3)
		 (let* ((db-file   (or out-file (pathname-file input-db)))
			(db-exists (file-exists? db-file))
			(db        (sqlite3:open-database db-file)))
		   (if (not db-exists)(sqlite3:execute db "CREATE TABLE data (sheet,section,var,val);"))
		   (configf:map-all-hier-alist
		    data
		    (lambda (sheetname sectionname varname val)
		      (sqlite3:execute db
				       "INSERT OR REPLACE INTO data (sheet,section,var,val) VALUES (?,?,?,?);"
				       sheetname sectionname varname val)))
		   (sqlite3:finalize! db)))
		(else
		 (pp data))))))
      (if out-file (close-output-port out-port))
      (exit) ;; yes, bending the rules here - need to exit since this is a utility
      ))

(if (args:get-arg "-ping")
    (let* ((run-id        (string->number (args:get-arg "-run-id")))
	   (host:port     (args:get-arg "-ping")))
      (server:ping run-id host:port)))

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

    (rmt:general-call 'state-status run-id newstate newstatus test-id))
   (else
    (if newstate   (rmt:general-call 'set-test-state   run-id newstate   test-id))
    (if newstatus  (rmt:general-call 'set-test-status  run-id newstatus  test-id))
    (if newcomment (rmt:general-call 'set-test-comment run-id newcomment test-id))))
   (mt:process-triggers run-id test-id newstate newstatus)
   #t)

(define (mt:test-set-state-status-by-testname run-id test-name item-path new-state new-status new-comment)
  (let ((test-id (cdb:remote-run db:get-test-id-cached #f run-id test-name item-path)))
    (mt:test-set-state-status-by-id test-id new-state new-status new-comment)))

(define (mt:lazy-read-test-config test-name)
  (let ((tconf (hash-table-ref/default *testconfigs* test-name #f)))
    (if tconf
	tconf
	(let ((test-dirs (tests:get-tests-search-path *configdat*)))
	  (let loop ((hed (car test-dirs))

	  #f)) ;; #f flags do not loop

     ((and (not (null? fails))(member 'toplevel testmode))
      (if (or (not (null? reg))(not (null? tal)))
	   (list (car newtal)(append (cdr newtal) reg) '() reruns)
	  #f)) 
     (else
      (debug:print 1 "WARNING: FAILS or incomplete tests are preventing completion of this run. Dropping test " hed " from the run queue")
      (list (runs:queue-next-hed tal reg reglen regfull)
		(runs:queue-next-tal tal reg reglen regfull)
		(runs:queue-next-reg tal reg reglen regfull)
		reruns))))) ;; (list (car newtal)(cdr newtal) reg reruns)))))
      (debug:print 0 "WARNING: FAILS or incomplete tests maybe preventing completion of this run. Watch for issues with test " hed ", continuing for now")
      ;; (list (runs:queue-next-hed tal reg reglen regfull)
      ;;   	(runs:queue-next-tal tal reg reglen regfull)
      ;;   	(runs:queue-next-reg tal reg reglen regfull)
      ;;   	reruns)
      (list (car newtal)(cdr newtal) reg reruns)))))

(define (runs:mixed-list-testname-and-testrec->list-of-strings inlst)
  (if (null? inlst)
      '()
      (map (lambda (t)
	     (cond
	      ((vector? t)
	       (let ((test-name (db:test-get-testname t))
		     (item-path (db:test-get-item-path t))
		     (test-state (db:test-get-state t))
	       (conc (db:test-get-state t) "/" (db:test-get-status t)))
		     (test-status (db:test-get-status t)))
		 (conc test-name (if (equal? item-path "") "" "/") item-path ":" test-state "/" test-status)))
	      ((string? t)
	       t)
	      (else 
	       (conc t))))
	   inlst)))

(define (runs:process-expanded-tests hed tal reg reruns reglen regfull test-record runname test-name item-path jobgroup max-concurrent-jobs run-id waitons item-path testmode test-patts required-tests test-registry registry-mutex flags keyvals run-info newtal all-tests-registry itemmap)

		      (string-intersperse 
		       (map (lambda (t)
			      (if (vector? t)
				  (conc (db:test-get-state t) "/" (db:test-get-status t))
				  (conc " WARNING: t is not a vector=" t )))
			    prereqs-not-met) ", ") ") fails: " fails)
    
    (if (not (null? prereqs-not-met))
    (if (and (not (null? prereqs-not-met))
	     (runs:lownoise (conc "waiting on tests " prereqs-not-met hed) 60))
	(debug:print-info 2 "waiting on tests; " (string-intersperse (runs:mixed-list-testname-and-testrec->list-of-strings prereqs-not-met) ", ")))

    ;; Don't know at this time if the test have been launched at some time in the past
    ;; i.e. is this a re-launch?
    (debug:print-info 4 "run-limits-info = " run-limits-info)
    
    (cond

     ;; must be we have unmet prerequisites
     ;;
     (else
      (debug:print 4 "FAILS: " fails)
      ;; If one or more of the prereqs-not-met are FAIL then we can issue
      ;; a message and drop hed from the items to be processed.
      ;; (runs:mixed-list-testname-and-testrec->list-of-strings prereqs-not-met)
      (if (not (null? prereqs-not-met))
      (if (and (not (null? prereqs-not-met))
	       (runs:lownoise (conc "waiting on tests " prereqs-not-met hed) 60))
	  (debug:print-info 1 "waiting on tests; " (string-intersperse 
						    (runs:mixed-list-testname-and-testrec->list-of-strings 
						     prereqs-not-met) ", ")))
      (if (null? fails)
	  (begin
	    ;; couldn't run, take a breather
	    (if  (runs:lownoise "Waiting for more work to do..." 60)
	    (debug:print-info 0 "Waiting for more work to do...")
		 (debug:print-info 0 "Waiting for more work to do..."))
	    (thread-sleep! 1)
	    (list (car newtal)(cdr newtal) reg reruns))
	  ;; the waiton is FAIL so no point in trying to run hed ever again
	  (if (or (not (null? reg))(not (null? tal)))
	      (if (vector? hed)
		  (begin 
		    (debug:print 1 "WARN: Dropping test " (db:test-get-testname hed) "/" (db:test-get-item-path hed)
		  (begin
		    (debug:print 1 "WARNING: Dropping test " test-name "/" item-path
				 " from the launch list as it has prerequistes that are FAIL")
		    (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?)
		    ;; (thread-sleep! *global-delta*)
		    (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "BLOCKED" #f)
		    (hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'removed)
		    (list (runs:queue-next-hed tal reg reglen regfull)
			  (runs:queue-next-tal tal reg reglen regfull)
			  (runs:queue-next-reg tal reg reglen regfull)
			  reruns ;; WAS: (cons hed reruns) ;; but that makes no sense?
			  ))
		  (let ((nth-try (hash-table-ref/default test-registry hed 0)))
		  (begin
		    (debug:print 0 "WARNING: Test may not have processed correctly. Could be a race condition in your test implementation? Dropping test " hed) ;;  " as it has prerequistes that are FAIL. (NOTE: hed is not a vector)")
		    (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?)
		    ;; (list hed tal reg reruns)
		    ;; (list (car newtal)(cdr newtal) reg reruns)
		    (list (runs:queue-next-hed tal reg reglen regfull)
			  (runs:queue-next-tal tal reg reglen regfull)
			  (runs:queue-next-reg tal reg reglen regfull)
			  reruns) ;; (cons hed reruns))
		    ;;(list (if (null? tal)(car newtal)(car tal))
		    ;;      tal
		    ;;      reg
		    ;;      reruns)
		    (cond
		     ((member "RUNNING" (map db:test-get-state prereqs-not-met))
		      (if (runs:lownoise (conc "possible RUNNING prerequistes " hed) 60)
			  (debug:print 0 "WARNING: test " hed " has possible RUNNING prerequisites, don't give up on it yet."))
		      (thread-sleep! 4)
		      (list (runs:queue-next-hed newtal reg reglen regfull)
			    (runs:queue-next-tal newtal reg reglen regfull)
			    (runs:queue-next-reg newtal reg reglen regfull)
			    reruns))
		     ((or (not nth-try)
			  (and (number? nth-try)
			       (< nth-try 10)))
		      (hash-table-set! test-registry hed (if (number? nth-try)
							     (+ nth-try 1)
							     0))
		      (if (runs:lownoise (conc "not removing test " hed) 60)
			  (debug:print 1 "WARNING: not removing test " hed " from queue although it may not be runnable due to FAILED prerequisites"))
		      ;; may not have processed correctly. Could be a race condition in your test implementation? Dropping test " hed) ;;  " as it has prerequistes that are FAIL. (NOTE: hed is not a vector)")
		      (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?)
		      ;; (list hed tal reg reruns)
		      ;; (list (car newtal)(cdr newtal) reg reruns)
		      ;; (hash-table-set! test-registry hed 'removed)
		      (list (runs:queue-next-hed newtal reg reglen regfull)
			    (runs:queue-next-tal newtal reg reglen regfull)
			    (runs:queue-next-reg newtal reg reglen regfull)
			    reruns))
		     ((symbol? nth-try)
		      (if (eq? nth-try 'removed) ;; removed is removed - drop it NOW
			  (if (null? tal)
			      #f ;; yes, really
			      (list (car tal)(cdr tal) reg reruns))
			  (begin
			    (if (runs:lownoise (conc "FAILED prerequisites or other issue" hed) 60)
				(debug:print 0 "WARNING: test " hed " has FAILED prerequisites or other issue. Internal state " nth-try " will be overridden and we'll retry."))
			    (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "KEEP_TRYING" #f)
			    (hash-table-set! test-registry hed 0)
			    (list (runs:queue-next-hed newtal reg reglen regfull)
				  (runs:queue-next-tal newtal reg reglen regfull)
				  (runs:queue-next-reg newtal reg reglen regfull)
				  reruns))))
		     (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)
		      (mt:roll-up-pass-fail-counts run-id test-name item-path "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)
		    #f   ;; I think we are truly done here
	      (list hed
		    tal
		    reg
		    reruns)))))))
		    (list (runs:queue-next-hed newtal reg reglen regfull)
			    (runs:queue-next-tal newtal reg reglen regfull)
			    (runs:queue-next-reg newtal reg reglen regfull)
			    reruns)))))))))

;; scan a list of tests looking to see if any are potentially runnable
(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)
		    ((NOT_STARTED)
		     (if (member status '("TEN_STRIKES" "BLOCKED"))
			 #f
			 t))
		    ((DELETED) #f)
		    (else t)))))
	  tests))

;; every time though the loop increment the test/itempatt val.
;; when the min is > max-allowed and none running then force exit
;;
(define *max-tries-hash* (make-hash-table))

;; test-records is a hash table testname:item_path => vector < testname testconfig waitons priority items-info ... >

	      (hash-table-set! test-registry (runs:make-full-test-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
	      (if (runs:lownoise (conc "been marked do not run " tfullname) 60)
	      (debug:print-info 0 "Skipping test " tfullname " as it has been marked do not run due to being completed or not runnable")
		  (debug:print-info 0 "Skipping test " tfullname " as it has been marked do not run due to being completed or not runnable"))
	      (if (or (not (null? tal))(not (null? reg)))
		  (loop (runs:queue-next-hed tal reg reglen regfull)
			(runs:queue-next-tal tal reg reglen regfull)
			(runs:queue-next-reg tal reg reglen regfull)
			reruns))))
		  ;; (loop (car tal)(cdr tal) reg reruns))))

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

dashboard : 
	$(DASHBOARD) -rows 20 &

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

clean :
	rm -rf ../simple*/*/* megatest.db db/*

# Add additional steps here. Format is "stepname script"
[vars]
step1var step1.sh

[ezsteps]
step1 step1.sh
step1 #{get vars step1var}

# Test requirements are specified here
[requirements]
# waiton setup
priority 0

# Iteration for your tests are controlled by the items section

CHICKEN_VERSION=4.8.0
SQLITE3_VERSION=3071401

# Eggs to install (straightforward ones)
EGGS=matchable readline apropos base64 regex-literals format regex-case test coops trace csv \
     dot-locking posix-utils posix-extras directory-utils hostinfo tcp-server rpc csv-xml fmt \
     json md5 awful http-client spiffy uri-common intarweb spiffy-request-vars \
     spiffy-directory-listing ssax sxml-serializer sxml-modifications sqlite3
     spiffy-directory-listing ssax sxml-serializer sxml-modifications sqlite3 sql-de-lite \
     srfi-19

#
# Derived variables
#

ifeq ($(PROXY),)
PROX=