Megatest

;; Copyright 2006-2011, 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")
(define megatest-version 1.12)

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

Usage: megatest [options]

Misc 
  -force                  : override some checks
  -xterm                  : start an xterm instead of launching the test
  -remove-runs            : remove the data for a run, requires fields, :runname 
                            and -testpatt
  -testpatt patt          : remove tests matching patt (requires -remove-runs)
  -keepgoing              : continue running until no jobs are \"LAUNCHED\" or
                            \"NOT_STARTED\"

Helpers
  -runstep stepname  ...  : take remaining params as comand and execute as stepname
                            log will be in stepname.log. Best to put command in quotes
  -logpro file            : with -exec apply logpro file to stepname.log, creates
                            stepname.html and sets log to same
                            If using make use stepname_logpro.log as your target

		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-test-status"
		        "-gui"
			"-runall"    ;; run all tests
			"-remove-runs"
			"-keepgoing"
		       )
		 args:arg-hash
		 0))

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

		(print "ERROR: Attempted to run a test but run area config file not found")
		(exit 1))
	      ;; put test parameters into convenient variables
	      (let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored for now
		(print "INFO: Attempting to start the following tests...")
		(print "     " (string-intersperse test-names ","))
		(run-tests db test-names)))
	  ;; (run-waiting-tests db)
	  (sqlite3:finalize! db)
	  (set! *didsomething* #t))))

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

	      (print "ERROR: Attempted to run a test but run area config file not found")
	      (exit 1))
	    ;; put test parameters into convenient variables
	    (let* ((test-names   (string-split (args:get-arg "-runtests") ",")))
	      (run-tests db test-names)))
	;; run-waiting-tests db)
	(sqlite3:finalize! db)
	;; (run-waiting-tests #f)
	(set! *didsomething* #t))))
	  
(if (args:get-arg "-runtests")
    (runtests))

;;======================================================================
;; execute the test

							     (- 
							      (current-seconds) 
							      start-seconds))))))
				     (let loop ((minutes   (calc-minutes)))
				       (let ((db    (open-db)))
					 (set! kill-job? (test-get-kill-request db run-id test-name itemdat))
					 (test-update-meta-info db run-id test-name itemdat minutes)
					 (if kill-job? 
					     (begin 
					       (process-signal (vector-ref exit-info 0) signal/term)
					       (sleep 2)
					       (handle-exceptions
						exn
						(print "ERROR: Problem killing process " (vector-ref exit-info 0))
						(process-signal (vector-ref exit-info 0) signal/kill))))
					 (sqlite3:finalize! db)
					 (thread-sleep! (+ 8 (random 4))) ;; add some jitter to the call home time to spread out the db accesses
					 (loop (calc-minutes)))))))
		   (th1          (make-thread monitorjob))
		   (th2          (make-thread runit)))
	      (thread-start! th1)
	      (thread-start! th2)

			 (redir      (case (string->symbol shell)
				       ((tcsh csh ksh)    ">&")
				       ((zsh bash sh ash) "2>&1 >")))
			 (fullcmd    (conc "(" (string-intersperse 
						(cons cmd params) " ")
					   ") " redir " " logfile)))
		    ;; mark the start of the test
		    (teststep-set-status! db run-id test-name stepname "start" "n/a" itemdat (args:get-arg "-m"))
		    ;; close the db
		    (sqlite3:finalize! db)
		    ;; run the test step
		    (print "INFO: Running \"" fullcmd "\"")
		    (change-directory startingdir)
		    (set! exitstat (system fullcmd)) ;; cmd params))
		    (set! *globalexitstatus* exitstat)