Megatest

    ((set-state-status-and-roll-up-items) (apply db:set-state-status-and-roll-up-items dbstruct params))
    ((set-state-status-and-roll-up-run) (apply db:set-state-status-and-roll-up-run dbstruct 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))
    ((lock/unlock-run)              (apply db:lock/unlock-run dbstruct params))
    ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))
    ((update-run-stats)             (apply db:update-run-stats dbstruct params))
    ((set-var)                      (apply db:set-var dbstruct params))
    ((inc-var)                      (apply db:inc-var dbstruct params))

;; assemble into dbr:dbdat struct and return
;; 
(define (db:open-dbdat apath dbfile dbinit-proc)
  (let* (;; (dbfile   (db:run-id->path apath run-id))
	 (db       (db:open-run-db dbfile dbinit-proc))
	 (inmem    (db:open-inmem-db dbinit-proc))
	 (dbdat    (make-dbr:dbdat
		    db:     db
		    inmem:  inmem
		    ;; run-id: run-id  ;; no can do, there are many run-id values that point to single db
		    fname:  dbfile)))
    ;; now sync the disk file data into the inmemory db
    (db:sync-tables (db:sync-all-tables-list) #f db inmem)

    dbdat))

;; open the disk database file
;; NOTE: May need to add locking to file create process here
;; returns an sqlite3 database handle
;;
(define (db:open-run-db dbfile dbinit-proc)

;; ;;     (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb)))

;; NOTE: touched logic is disabled/not done
;; sync run to disk if touched
;;
(define (db:sync-inmem->disk dbstruct apath dbfile #!key (force-sync #f))
  (let* ((dbdat       (db:get-dbdat dbstruct apath dbfile))

	 (db          (dbr:dbdat-db dbdat))
	 (inmem       (dbr:dbdat-inmem dbdat))
	 (start-t     (current-seconds))
	 (last-update (dbr:dbdat-last-write dbdat))
	 (last-sync   (dbr:dbdat-last-sync dbdat)))
    (debug:print-info 0 *default-log-port* "Syncing for dbfile: "dbfile", last-update: "last-update", last-sync: "last-sync)
    (mutex-lock! *db-multi-sync-mutex*)
    (let* ((update_info (cons "last_update" (if force-sync 0 last-update))) ;;  "last_update"))
    	   (need-sync   (or force-sync (>= last-update last-sync))))
       (if need-sync
	   (begin
	     (db:sync-tables (db:sync-all-tables-list) update_info inmem db)
	     (dbr:dbdat-last-sync-set! dbdat start-t))
	  (debug:print 0 *default-log-port* "Skipping sync as nothing touched.")))

    (mutex-unlock! *db-multi-sync-mutex*)))

;; TODO: Add final sync to this
;;
(define (db:safely-close-sqlite3-db db stmt-cache #!key (try-num 3))
  (if (<= try-num 0)
      #f
      (handle-exceptions
	  exn
	(begin
	  (print "Attempt to safely close sqlite3 db failed. Trying again. exn=" exn)
	  (thread-sleep! 3)
	  (sqlite3:interrupt! db)
	  (db:safely-close-sqlite3-db db stmt-cache try-num: (- try-num 1)))
	(if (sqlite3:database? db)
	    (let* ((stmts (and stmt-cache (hash-table-ref/default stmt-cache db #f))))
	      (if stmts (map sqlite3:finalize! (hash-table-values stmts)))
	      (sqlite3:finalize! db)
	      #t)
	    #f))))

;; close all opened run-id dbs
(define (db:close-all dbstruct)
  (assert (dbr:dbstruct? dbstruct) "FATAL: db:close-all called with dbstruct not set up.")
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "WARNING: Finalizing failed, "  ((condition-property-accessor 'exn 'message) exn) ", note - exn=" exn)
     (print-call-chain *default-log-port*))
   ;; (db:sync-touched dbstruct 0 force-sync: #t) ;; NO. Do not do this here. Instead we rely on a server to be started when there are writes, even if the server itself is not going to be used as a server.

	   (sqlite3:execute "DELETE FROM servers WHERE state LIKE 'defunct%';"))
	  (else
	   (sqlite3:execute db "vacuum;")))
	 
	 (sqlite3:finalize! db)
	 #t))))))


(define (db:sync-one-table fromdb todb tabledat last-update numrecs)

  (let* ((tablename        (car tabledat))
	 (fields           (cdr tabledat))
	 (has-last-update  (member "last_update" fields))
	 (use-last-update  (cond
			    ((and has-last-update
				  (number? last-update))
			     #t) ;; if given a number, just use it for all fields
			    ((and (pair? last-update)
				  (member (car last-update)    ;; last-update field name
					  (map car fields)))
			     #t)
			    ((and (pair? last-update)
				  (not (number? (cdr last-update))))
			     (debug:print 0 *default-log-port* "ERROR: parameter last-update malformed. last-update="last-update)
			     #f)
			    ((and (pair? last-update)
				  (string? (car last-update))) ;; valid format, field not recognised
			     #f)
			    ((number? last-update) #f) ;; if not matched first entry then ignore last-update for this table
			    (last-update
			     (debug:print 0 *default-log-port* "ERROR: parameter last-update for db:sync-tables must be a pair or a number, received: " last-update);; found in fields
			     #f)
			    (else
			     #f)))
	 (last-update-value (if use-last-update ;; no need to check for has-last-update - it is already accounted for
				(if (number? last-update)
				    last-update
				    (cdr last-update))
				#f))
	 (last-update-field (if use-last-update
				(if (number? last-update)
				    "last_update"
				    (car last-update))
				#f))
	 (num-fields (length fields))
	 (field->num (make-hash-table))
	 (num->field (apply vector (map car fields))) ;; BBHERE
	 (full-sel   (conc "SELECT " (string-intersperse (map car fields) ",") 
			   " FROM " tablename (if use-last-update ;; apply last-update criteria
						  (conc " WHERE " last-update-field " >= " last-update-value)
						  "")

;; db's are sqlite3 handles
;;
;; if last-update specified ("field-name" . time-in-seconds)
;;    then sync only records where field-name >= time-in-seconds
;;    IFF field-name exists
;;
(define (db:sync-tables tbls last-update fromdb todb)

  ;; NOTE: I'm moving all the checking OUT of this routine. Check for read/write access, existance, etc
  ;;       BEFORE calling this sync
  
  (let ((stmts       (make-hash-table)) ;; table-field => stmt
	(all-stmts   '())              ;; ( ( stmt1 value1 ) ( stml2 value2 ))
	(numrecs     (make-hash-table))
	(start-time  (current-milliseconds))

			  (string->number res)
			  #f)))
          (if newres
              newres
              res))
        res)))

(define (db:no-sync-close-db db stmt-cache)
  (db:safely-close-sqlite3-db db stmt-cache))

;; transaction protected lock aquisition
;; either:
;;    fails    returns  (#f . lock-creation-time)
;;    succeeds (returns (#t . lock-creation-time)
;; use (db:no-sync-del! db keyname) to release the lock

    (debug:print 2 *default-log-port* "NOTE: using target " (string-intersperse (map cadr keyvals) "/") " for this run")
    (if (and runname (null? (filter (lambda (x)(not x)) keyvals))) ;; there must be a better way to "apply and"
	(db:with-db
	 dbstruct #f #f
	 (lambda (db)
	   (let ((res #f))
	     (apply sqlite3:execute db (conc "INSERT OR IGNORE INTO runs (runname,state,status,owner,event_time,contour" comma keystr ") VALUES (?,?,?,?,strftime('%s','now'),?" comma valslots ");")




































		    allvals)
	     (apply sqlite3:for-each-row 
		    (lambda (id)
		      (set! res id))
		    db
		    (let ((qry (conc "SELECT id FROM runs WHERE (runname=? " andstr key=?str ");")))
		      qry)

;; Use the special run-id == #f scenario here since there is no run yet
(define (rmt:register-run keyvals runname state status user contour)
  ;; first register in main.db (thus the #f)
  (let* ((run-id (rmt:send-receive 'register-run #f (list keyvals runname state status user contour))))
    ;; now register in the run db itself

    ;; NEED A RECORD INSERT INCLUDING SETTING id
    (rmt:send-receive 'register-run run-id (list keyvals runname state status user contour))
    
    run-id))
  
(define (rmt:get-run-name-from-id run-id)
  (rmt:send-receive 'get-run-name-from-id run-id (list run-id)))

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

			(thread-start! watchdog))
		      (debug:print-info 0 *default-log-port* "Not starting watchdog thread (in state "(thread-state watchdog)")"))
		  (debug:print 0 *default-log-port* "ERROR: *watchdog* not setup, cannot start it."))
	      #;(loop (+ count 1) bad-sync-count start-time)
	      ))

	(debug:print-info 0 *default-log-port* "syncing "*toppath*" "dbname" at "(current-seconds))
	(db:sync-inmem->disk *dbstruct-db* *toppath* dbname)
	
	(mutex-unlock! *heartbeat-mutex*)
	
	;; when things go wrong we don't want to be doing the various
	;; queries too often so we strive to run this stuff only every
	;; four seconds or so.
	(let* ((sync-time (- (current-milliseconds) start-time))

(test #f 1 (rmt:send-receive 'register-run 1 (list keyvals "run1" "new" "n/a" "justme" #f)))

(test #f 2 (rmt:register-run keyvals "run2" "new" "n/a" "justme" #f))
;; (test #f 2 (rmt:deregister-server *rmt:remote* *toppath* iface port server-key dbname

(test #f 2 (rmt:get-count-servers *rmt:remote* *toppath*))

(exit)


;; (delete-file* "logs/1.log")
;; (define run-id 1)

;; (test "setup for run" #t (begin (launch:setup)
;;  				(string? (getenv "MT_RUN_AREA_HOME"))))
;; 
;; (test #f #t (and (server:kind-run *toppath*) #t))
;; 
;; 
;; (define user    (current-user-name))
;; (define runname "mytestrun")
;; (define keys    (rmt:get-keys))
;; (define runinfo #f)
;; (define keyvals '(("SYSTEM" "abc")("RELEASE" "def")))
;; (define header  (list "SYSTEM" "RELEASE" "id" "runname" "state" "status" "owner" "event_time"))
;; 
;; ;; Setup
;; ;;
;; ;; (test #f #f  (not (client:setup run-id)))
;; ;; (test #f #f  (not (hash-table-ref/default *runremote* run-id #f)))
;; 
;; ;; Login
;; ;;
;; (test #f'(#t "successful login")
;;       (rmt:login run-id))
;; 
;; ;; Keys
;; ;;
;; (test #f '("SYSTEM" "RELEASE")  (rmt:get-keys))
;; 
;; ;; No data in db
;; ;;
;; (test #f '() (rmt:get-all-run-ids))
;; (test #f #f  (rmt:get-run-name-from-id run-id))
;; (test #f 
;;       (vector
;;        header
;;        (vector #f #f #f #f))
;;       (rmt:get-run-info run-id))
;; 
;; ;; Insert data into db
;; ;;
;; (test #f 1 (rmt:register-run keyvals runname "new" "n/a" user))
;; ;; (test #f #f (rmt:get-runs-by-patt keys runname))
;; (test #f #t (rmt:general-call 'register-test run-id run-id "test-one" ""))
;; (define test-one-id #f)
;; (test #f 1  (let ((test-id (rmt:get-test-id run-id "test-one" "")))
;; 	      (set! test-one-id test-id)
;; 	      test-id))
;; (define test-one-rec #f)
;; (test #f "test-one" (let ((test-rec (rmt:get-test-info-by-id run-id test-one-id)))
;; 		      (set! test-one-rec test-rec)
;; 		      (vector-ref test-rec 2)))
;; 
;; ;; With data in db
;; ;;
;; (print "Using runame=" runname)
;; (test #f '(1)    (rmt:get-all-run-ids))
;; (test #f runname (rmt:get-run-name-from-id run-id))
;; (test #f 
;;       runname
;;       (let ((run-info (rmt:get-run-info run-id)))
;; 	(db:get-value-by-header (db:get-rows run-info)
;; 				(db:get-header run-info)
;; 				"runname")))
;; 
;; ;; test killing server
;; ;;
;; (for-each
;;  (lambda (run-id)
;;    (test #f #t (and (tasks:kill-server-run-id run-id) #t))
;;    (test #f #f (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db)) run-id)))
;;  (list 0 1))
;; 
;; ;; Tests to assess reading/writing while servers are starting/stopping
;; ;; NO LONGER APPLICABLE
;; 
;; ;; Server tests go here
;; (define (server-tests-dont-run-right-now)
;; (for-each
;;  (lambda (run-id)
;;    (test #f #f (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db)) run-id))
;;    (server:kind-run run-id)
;;    (test "did server start within 20 seconds?"
;; 	 #t
;; 	 (let loop ((remtries 20)
;; 		    (running (tasks:server-running-or-starting? (db:delay-if-busy
;; 								 (tasks:open-db))
;; 								run-id)))
;; 	   (if running 
;; 	       (> running 0)
;; 	       (if (> remtries 0)
;; 		   (begin
;; 		     (thread-sleep! 1)
;; 		     (loop (- remtries 1)
;; 			   (tasks:server-running-or-starting? (db:delay-if-busy
;; 							       (tasks:open-db))
;; 							      run-id)))))))
;;    
;;    (test "did server become available" #t
;; 	 (let loop ((remtries 10)
;; 		    (res      (tasks:get-server (db:delay-if-busy (tasks:open-db)) run-id)))
;; 	   (if res
;; 	       (vector? res)
;; 	       (begin
;; 		 (if (> remtries 0)
;; 		     (begin
;; 		       (thread-sleep! 1.1)
;; 		       (loop (- remtries 1)(tasks:get-server (db:delay-if-busy (tasks:open-db)) run-id)))
;; 		     res)))))
;;    )
;;  (list 0 1)))
;; 
;; (define start-time (current-seconds))
;; (define (reading-writing-while-server-starting-stopping-dont-run-now)
;; (let loop ((test-state 'start))
;;   (let* ((server-dats (tasks:get-server-records (db:delay-if-busy (tasks:open-db)) run-id))
;; 	 (first-dat   (if (not (null? server-dats))
;; 			  (car server-dats)
;; 			  #f)))
;;     (map (lambda (dat)
;; 	   (apply print (intersperse (vector->list dat) ", ")))
;; 	 server-dats)
;;     (test #f test-one-rec (rmt:get-test-info-by-id run-id test-one-id))
;;     (thread-sleep! 1)
;;     (case test-state
;;       ((start)
;;        (print "Trying to start server")
;;        (server:kind-run run-id)
;;        (loop 'server-started))
;;       ((server-started)
;;        (case (if first-dat (vector-ref first-dat 0) 'blah)
;; 	 ((running)
;; 	  (print "Server appears to be running. Now ask it to shutdown")
;; 	  (rmt:kill-server run-id)
;; 	  (loop 'server-shutdown))
;; 	 ((shutting-down)
;; 	  (loop test-state))
;; 	 (else (print "Don't know what to do if get here"))))
;;       ((server-shutdown)
;;        (loop test-state)))))
;; )

;;======================================================================
;; END OF TESTS
;;======================================================================


;; (test #f #f (client:setup run-id))

;; (set! *transport-type* 'http)
;; 
;; (test "setup for run" #t (begin (launch:setup-for-run)
;; 				(string? (getenv "MT_RUN_AREA_HOME"))))
;; 
;; (test "server-register, get-best-server" #t (let ((res #f))
;; 					      (open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 100 'live 'http)
;; 					      (set! res (open-run-close tasks:get-best-server tasks:open-db))
;; 					      (number? (vector-ref res 3))))
;; 
;; (test "de-register server" #f (let ((res #f))
;; 				(open-run-close tasks:server-deregister tasks:open-db "bob" port: 1234)
;; 				(vector? (open-run-close tasks:get-best-server tasks:open-db))))
;; 
;; (define server-pid #f)
;; 
;; ;; Not sure how the following should work, replacing it with system of megatest -server
;; ;; (test "launch server" #t (let ((pid (process-fork (lambda ()
;; ;; 						    ;; (daemon:ize)
;; ;; 						    (server:launch 'http)))))
;; ;; 			   (set! server-pid pid)
;; ;; 			   (number? pid)))
;; (system "../../bin/megatest -server - -debugbcom 22 > server.log 2> server.log &")
;; 
;; (let loop ((n 10))
;;   (thread-sleep! 1) ;; need to wait for server to start.
;;   (let ((res (open-run-close tasks:get-best-server tasks:open-db)))
;;     (print "tasks:get-best-server returned " res)
;;     (if (and (not res)
;; 	     (> n 0))
;; 	(loop (- n 1)))))
;; 
;; (test "get-best-server" #t (begin 
;; 			     (client:launch)
;; 			     (let ((dat (open-run-close tasks:get-best-server tasks:open-db)))
;; 			       (vector? dat))))
;; 
;; (define *keys*               (keys:config-get-fields *configdat*))
;; (define *keyvals*            (keys:target->keyval *keys* "a/b/c"))
;; 
;; (test #f #t                       (string? (car *runremote*)))
;; (test #f '(#t "successful login") (rmt:login)) ;;  *runremote* *toppath* *my-client-signature*)))
;; 
;; (test #f #f                       (rmt:get-test-info-by-id 99)) ;; get non-existant test
;; 
;; ;; RUNS
;; (test #f 1                        (rmt:register-run  *keyvals* "firstrun" "new" "n/a" (current-user-name)))
;; (test "get run info"  "firstrun"  (let ((rinfo (rmt:get-run-info 1)))
;; 				    (vector-ref (vector-ref rinfo 1) 3)))
;; (test "get runname from id" "firstrun" (rmt:get-run-name-from-id 1))
;; 
;; ;; TESTS
;; (test "get tests (no data)" '()   (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f))
;; (test "register test"       #t    (rmt:general-call 'register-test 1 "test1" ""))
;; (test "get tests (some data)"  1  (length (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f)))
;; (test "get test id"            1  (rmt:get-test-id 1 "test1" ""))
;; (test "sync back"              #t (> (rmt:sync-inmem->db) 0))
;; (test "get test id from main"  1  (db:get-test-id *db* 1 "test1" ""))
;; (test "get keys"               #t (list? (rmt:get-keys)))
;; (test "set comment"            #t (begin (rmt:general-call 'set-test-comment "this is a comment" 1) #t))
;; (test "get comment" "this is a comment" (let ((trec (rmt:get-test-info-by-id 1)))
;; 					  (db:test-get-comment trec)))
;; 
;; ;; MORE RUNS
;; (test "get runs"  #t (let* ((runs   (rmt:get-runs "%" #f #f '()))
;; 			    (header (vector-ref runs 0))
;; 			    (data   (vector-ref runs 1)))
;; 		       (and (list?   header)
;; 			    (list?   data)
;; 			    (vector? (car data)))))
;; 
;; (test "get local testinfo" "test1" (vector-ref (db:get-testinfo-state-status *db* 1) 2))
;; (test "get testinfo"       "test1" (vector-ref (rmt:get-testinfo-state-status 1) 2))
;; 
;; ;;======================================================================
;; ;; D B
;; ;;======================================================================
;; 
;; (test "pass fail counts" #t (rmt:general-call 'pass-fail-counts 10 9 1))
;; (test "get pass fail counts" 19 (let ((dat (rmt:get-test-info-by-id 1)))
;; 				  (+ (db:test-get-pass_count dat)
;; 				     (db:test-get-fail_count dat))))
;; 
;; (define testregistry (make-hash-table))
;; (for-each
;;  (lambda (tname)
;;    (for-each
;;     (lambda (itempath)
;;       (let ((tkey  (conc tname "/" itempath))
;; 	    (rpass (random 10))
;; 	    (rfail (random 10)))
;; 	(hash-table-set! testregistry tkey (list tname itempath))
;; 	(rmt:general-call 'register-test 1 tname itempath)
;; 	(let* ((tid  (rmt:get-test-id 1 tname itempath))
;; 	       (tdat (rmt:get-test-info-by-id tid)))
;; 	  (rmt:general-call 'pass-fail-counts rpass rfail (db:test-get-id tdat))
;; 	  (let* ((resdat (rmt:get-test-info-by-id tid)))
;; 	    (test "set/get pass fail counts" (list rpass rfail)
;; 		  (list (db:test-get-pass_count resdat)
;; 			(db:test-get-fail_count resdat)))))))
;;     (list "" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j")))
;;  (list "test1" "test2" "test3" "test4" "test5"))
;; 
;; 
;; (test #f '(#t "exit process started") (rmt:kill-server)) ;; *toppath* *my-client-signature* #f)))
;; 

;; (exit)


;; ;; ;; ;; all old stuff below
;; ;; ;; 
;; ;; ;; 
;; ;; ;; 
;; ;; ;; 
;; ;; ;; (delete-file* "logs/1.log")
;; ;; ;; (define run-id 1)
;; ;; ;; 
;; ;; ;; (test "setup for run" #t (begin (launch:setup-for-run)
;; ;; ;;  				(string? (getenv "MT_RUN_AREA_HOME"))))
;; ;; ;; 
;; ;; ;; ;; Insert data into db
;; ;; ;; ;;
;; ;; ;; (define user    (current-user-name))
;; ;; ;; (define runname "mytestrun")
;; ;; ;; (define keys    (rmt:get-keys))
;; ;; ;; (define runinfo #f)
;; ;; ;; (define keyvals '(("SYSTEM" "abc")("RELEASE" "def")))
;; ;; ;; (define header  (list "SYSTEM" "RELEASE" "id" "runname" "state" "status" "owner" "event_time"))
;; ;; ;; 
;; ;; ;; (test #f 1 (rmt:register-run keyvals runname "new" "n/a" user))
;; ;; ;; ;; (test #f #f (rmt:get-runs-by-patt keys runname))
;; ;; ;; (test #f #t (rmt:general-call 'register-test run-id run-id "test-one" ""))
;; ;; ;; (define test-one-id #f)
;; ;; ;; (test #f 30001  (let ((test-id (rmt:get-test-id run-id "test-one" "")))
;; ;; ;; 	      (set! test-one-id test-id)
;; ;; ;; 	      test-id))
;; ;; ;; (define test-one-rec #f)
;; ;; ;; (test #f "test-one" (let ((test-rec (rmt:get-test-info-by-id run-id test-one-id)))
;; ;; ;; 		      (set! test-one-rec test-rec)
;; ;; ;; 		      (vector-ref test-rec 2)))
;; ;; ;; 
;; ;; ;; (use trace)
;; ;; ;; (import trace)
;; ;; ;; ;; (trace
;; ;; ;; ;;  rmt:send-receive
;; ;; ;; ;;  rmt:open-qry-close-locally
;; ;; ;; ;; )
;; ;; ;; 
;; ;; ;; ;; Tests to assess reading/writing while servers are starting/stopping
;; ;; ;; (define start-time (current-seconds))
;; ;; ;; (let loop ((test-state 'start))
;; ;; ;;   (let* ((server-dats (tasks:get-server-records (db:delay-if-busy (tasks:open-db)) run-id))
;; ;; ;; 	 (first-dat   (if (not (null? server-dats))
;; ;; ;; 			  (car server-dats)
;; ;; ;; 			  #f))
;; ;; ;; 	 (server-state (or (and first-dat (string->symbol (vector-ref first-dat 8))) 'no-dat)))
;; ;; ;;     (if first-dat
;; ;; ;; 	(map (lambda (dat)
;; ;; ;; 	       (apply print (intersperse (vector->list dat) ", ")))
;; ;; ;; 	     server-dats)
;; ;; ;; 	(print "No server"))
;; ;; ;;     (test #f test-one-rec (rmt:get-test-info-by-id run-id test-one-id))
;; ;; ;;     (thread-sleep! 1)
;; ;; ;;     (case test-state
;; ;; ;;       ((start)
;; ;; ;;        (print "Trying to start server")
;; ;; ;;        (server:kind-run run-id)
;; ;; ;;        (loop 'server-started))
;; ;; ;;       ((server-started)
;; ;; ;;        (case server-state 
;; ;; ;; 	 ((running)
;; ;; ;; 	  (print "Server appears to be running. Now ask it to shutdown")
;; ;; ;; 	  (rmt:kill-server run-id)
;; ;; ;; 	  ;; (trace rmt:open-qry-close-locally rmt:send-receive)
;; ;; ;; 	  (loop 'shutdown-started))
;; ;; ;; 	 ((available)
;; ;; ;; 	  (loop test-state))
;; ;; ;; 	 ((shutting-down)
;; ;; ;; 	  (loop test-state))
;; ;; ;; 	 ((no-dat)
;; ;; ;; 	  (loop test-state))
;; ;; ;; 	 (else (print "Don't know what to do if get here"))))
;; ;; ;;       ((shutdown-started)
;; ;; ;;        (case server-state 
;; ;; ;; 	 ((no-dat)
;; ;; ;; 	  (print "Server appears to have shutdown, ending this test"))
;; ;; ;; 	 (else
;; ;; ;; 	  (loop test-state)))))))
;; ;; ;; 
;; ;; ;; (exit)	 
;; ;; ;;        
;; ;; ;; ;; (set! *transport-type* 'http)
;; ;; ;; ;; 
;; ;; ;; ;; (test "setup for run" #t (begin (setup-for-run)
;; ;; ;; ;; 				(string? (getenv "MT_RUN_AREA_HOME"))))
;; ;; ;; ;; 
;; ;; ;; ;; (test "server-register, get-best-server" #t (let ((res #f))
;; ;; ;; ;; 					      (open-run-close tasks:server-register tasks:open-db 1 "bob" 1234 100 'live 'http)
;; ;; ;; ;; 					      (set! res (open-run-close tasks:get-best-server tasks:open-db))
;; ;; ;; ;; 					      (number? (vector-ref res 3))))
;; ;; ;; ;; 
;; ;; ;; ;; (test "de-register server" #f (let ((res #f))
;; ;; ;; ;; 				(open-run-close tasks:server-deregister tasks:open-db "bob" port: 1234)
;; ;; ;; ;; 				(vector? (open-run-close tasks:get-best-server tasks:open-db))))
;; ;; ;; ;; 
;; ;; ;; ;; (define server-pid #f)
;; ;; ;; ;; 
;; ;; ;; ;; ;; Not sure how the following should work, replacing it with system of megatest -server
;; ;; ;; ;; ;; (test "launch server" #t (let ((pid (process-fork (lambda ()
;; ;; ;; ;; ;; 						    ;; (daemon:ize)
;; ;; ;; ;; ;; 						    (server:launch 'http)))))
;; ;; ;; ;; ;; 			   (set! server-pid pid)
;; ;; ;; ;; ;; 			   (number? pid)))
;; ;; ;; ;; (system "../../bin/megatest -server - -debug 22 > server.log 2> server.log &")
;; ;; ;; ;; 
;; ;; ;; ;; (let loop ((n 10))
;; ;; ;; ;;   (thread-sleep! 1) ;; need to wait for server to start.
;; ;; ;; ;;   (let ((res (open-run-close tasks:get-best-server tasks:open-db)))
;; ;; ;; ;;     (print "tasks:get-best-server returned " res)
;; ;; ;; ;;     (if (and (not res)
;; ;; ;; ;; 	     (> n 0))
;; ;; ;; ;; 	(loop (- n 1)))))
;; ;; ;; ;; 
;; ;; ;; ;; (test "get-best-server" #t (begin 
;; ;; ;; ;; 			     (client:launch)
;; ;; ;; ;; 			     (let ((dat (open-run-close tasks:get-best-server tasks:open-db)))
;; ;; ;; ;; 			       (vector? dat))))
;; ;; ;; ;; 
;; ;; ;; ;; (define *keys*               (keys:config-get-fields *configdat*))
;; ;; ;; ;; (define *keyvals*            (keys:target->keyval *keys* "a/b/c"))
;; ;; ;; ;; 
;; ;; ;; ;; (test #f #t                       (string? (car *runremote*)))
;; ;; ;; ;; (test #f '(#t "successful login") (rmt:login)) ;;  *runremote* *toppath* *my-client-signature*)))
;; ;; ;; ;; 
;; ;; ;; ;; (test #f #f                       (rmt:get-test-info-by-id 1 99)) ;; get non-existant test
;; ;; ;; ;; 
;; ;; ;; ;; ;; RUNS
;; ;; ;; ;; (test #f 1                        (rmt:register-run  *keyvals* "firstrun" "new" "n/a" (current-user-name)))
;; ;; ;; ;; (test "get run info"  "firstrun"  (let ((rinfo (rmt:get-run-info 1)))
;; ;; ;; ;; 				    (vector-ref (vector-ref rinfo 1) 3)))
;; ;; ;; ;; (test "get runname from id" "firstrun" (rmt:get-run-name-from-id 1))
;; ;; ;; ;; 
;; ;; ;; ;; ;; TESTS
;; ;; ;; ;; (test "get tests (no data)" '()   (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f))
;; ;; ;; ;; (test "register test"       #t    (rmt:general-call 'register-test 1 1 "test1" ""))
;; ;; ;; ;; (test "get tests (some data)"  1  (length (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f)))
;; ;; ;; ;; (test "get test id"            1  (rmt:get-test-id 1 "test1" ""))
;; ;; ;; ;; 
;; ;; ;; ;; (test "sync back"              #t (> (rmt:sync-inmem->db) 0))
;; ;; ;; ;; (test "get test id from main"  1  (db:get-test-id *db* 1 "test1" ""))
;; ;; ;; ;; 
;; ;; ;; ;; (test "get keys"               #t (list? (rmt:get-keys)))
;; ;; ;; ;; (test "set comment"            #t (begin (rmt:general-call 'set-test-comment 1 "this is a comment" 1) #t))
;; ;; ;; ;; (test "get comment" "this is a comment" (let ((trec (rmt:get-test-info-by-id 1 1)))
;; ;; ;; ;; 					  (db:test-get-comment trec)))
;; ;; ;; ;; 
;; ;; ;; ;; ;; MORE RUNS
;; ;; ;; ;; (test "get runs"  #t (let* ((runs   (rmt:get-runs "%" #f #f '()))
;; ;; ;; ;; 			    (header (vector-ref runs 0))
;; ;; ;; ;; 			    (data   (vector-ref runs 1)))
;; ;; ;; ;; 		       (and (list?   header)
;; ;; ;; ;; 			    (list?   data)
;; ;; ;; ;; 			    (vector? (car data)))))
;; ;; ;; ;; 
;; ;; ;; ;; (test "get local testinfo" "test1" (vector-ref (db:get-testinfo-state-status *db* 1 1) 2))
;; ;; ;; ;; (test "get testinfo"       "test1" (vector-ref (rmt:get-testinfo-state-status 1 1) 2))
;; ;; ;; ;; 
;; ;; ;; ;; ;;======================================================================
;; ;; ;; ;; ;; D B
;; ;; ;; ;; ;;======================================================================
;; ;; ;; ;; 
;; ;; ;; ;; (test "pass fail counts" #t (rmt:general-call 'pass-fail-counts 10 9 1))
;; ;; ;; ;; (test "get pass fail counts" 19 (let ((dat (rmt:get-test-info-by-id 1)))
;; ;; ;; ;; 				  (+ (db:test-get-pass_count dat)
;; ;; ;; ;; 				     (db:test-get-fail_count dat))))
;; ;; ;; ;; 
;; ;; ;; ;; (define testregistry (make-hash-table))
;; ;; ;; ;; (for-each
;; ;; ;; ;;  (lambda (tname)
;; ;; ;; ;;    (for-each
;; ;; ;; ;;     (lambda (itempath)
;; ;; ;; ;;       (let ((tkey  (conc tname "/" itempath))
;; ;; ;; ;; 	    (rpass (random 10))
;; ;; ;; ;; 	    (rfail (random 10)))
;; ;; ;; ;; 	(hash-table-set! testregistry tkey (list tname itempath))
;; ;; ;; ;; 	(rmt:general-call 'register-test 1 tname itempath)
;; ;; ;; ;; 	(let* ((tid  (rmt:get-test-id 1 tname itempath))
;; ;; ;; ;; 	       (tdat (rmt:get-test-info-by-id tid)))
;; ;; ;; ;; 	  (rmt:general-call 'pass-fail-counts rpass rfail (db:test-get-id tdat))
;; ;; ;; ;; 	  (let* ((resdat (rmt:get-test-info-by-id tid)))
;; ;; ;; ;; 	    (test "set/get pass fail counts" (list rpass rfail)
;; ;; ;; ;; 		  (list (db:test-get-pass_count resdat)
;; ;; ;; ;; 			(db:test-get-fail_count resdat)))))))
;; ;; ;; ;;     (list "" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j")))
;; ;; ;; ;;  (list "test1" "test2" "test3" "test4" "test5"))
;; ;; ;; ;; 
;; ;; ;; ;; 
;; ;; ;; ;; (test #f '(#t "exit process started") (rmt:kill-server)) ;; *toppath* *my-client-signature* #f)))
;; ;; ;; ;; 
;; ;; ;;