Megatest

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

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

(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 format readline apropos zmq) ;; (srfi 18) extras)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))

(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses runs))

;; Misc general calls
;;======================================================================

(if (args:get-arg "-env2file")
    (begin
      (save-environment-as-files (args:get-arg "-env2file"))
      (set! *didsomething* #t)))

;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;;   we start the server if not running else start the client thread
;;======================================================================
(if (args:get-arg "-server")
    (server:launch)
    (server:client-launch))

;;======================================================================
;; Remove old run(s)
;;======================================================================

;; since several actions can be specified on the command line the removal
;; is done first

				       (db:step-get-event_time step)))
			     steps)))))
		  tests))))
	   runs)
	  (set! *didsomething* #t)
	  )))


















;;======================================================================
;; full run
;;======================================================================

;; get lock in db for full run for this directory
;; for all tests with deps
;;   walk tree of tests to find head tasks
;;   add head tasks to task queue
;;   add dependant tasks to task queue 
;;   add remaining tasks to task queue
;; for each task in task queue
;;   if have adequate resources
;;     launch task
;;   else
;;     put task in deferred queue
;; if still ok to run tasks
;;   process deferred tasks per above steps

;; run all tests are are Not COMPLETED and PASS or CHECK
(if (args:get-arg "-runall")
    (let ((server-thread #f))
      (if (args:get-arg "-server")
	  (let ((toppath (setup-for-run))
		(db      (open-db)))
	    (if db 
		(let* ((host:port (db:get-var db "SERVER")) ;; this doen't support multiple servers BUG!!!!
		       (th2 (server:start db (args:get-arg "-server")))
		       (th3 (make-thread (lambda ()
					   (server:keep-running db host:port)))))
		  (thread-start! th3)
		  (set! server-thread th3)))))
      (general-run-call 
       "-runall"
       "run all tests"
       (lambda (target runname keys keynames keyvallst)
	 (runs:run-tests target
			 runname
			 (if (args:get-arg "-testpatt")
			     (args:get-arg "-testpatt")
			     "%/%")
			 user
			 args:arg-hash)))
      (if server-thread 
	  (thread-join! server-thread))))

;;======================================================================
;; run one test
;;======================================================================

;; 1. find the config file
;; 2. change to the test directory

	    (current-input-port (make-gnu-readline-port "megatest> "))
	    (repl)))
      (set! *didsomething* #t)))

;;======================================================================
;; Exit and clean up
;;======================================================================

;; this is the socket if we are a client
(if (socket? *runremote*)
    (close-socket *runremote*))

(if (not *didsomething*)
    (debug:print 0 help))

;; (if *runremote* (rpc:close-all-connections!))
    
(if (not (eq? *globalexitstatus* 0))