File Annotation
Not logged in
ae6dbecf17 2011-05-02          matt: ;; Copyright 2006-2011, Matthew Welland.
ae6dbecf17 2011-05-02          matt: ;;
ae6dbecf17 2011-05-02          matt: ;;  This program is made available under the GNU GPL version 2.0 or
ae6dbecf17 2011-05-02          matt: ;;  greater. See the accompanying file COPYING for details.
ae6dbecf17 2011-05-02          matt: ;;
ae6dbecf17 2011-05-02          matt: ;;  This program is distributed WITHOUT ANY WARRANTY; without even the
ae6dbecf17 2011-05-02          matt: ;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
ae6dbecf17 2011-05-02          matt: ;;  PURPOSE.
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (include "common.scm")
b5bfe140e0 2011-05-24          matt: (define megatest-version 1.09)
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (define help (conc "
c4edfbcd13 2011-05-05      mrwellan: Megatest, documentation at http://www.kiatoa.com/fossils/megatest
ae6dbecf17 2011-05-02          matt:   version " megatest-version "
ae6dbecf17 2011-05-02          matt:   license GPL, Copyright Matt Welland 2006-2011
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: Usage: megatest [options]
ae6dbecf17 2011-05-02          matt:   -h                      : this help
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: Process and test running
cf78fcded0 2011-05-04          matt:   -runall                 : run all tests that are not state COMPLETED and status PASS,
cf78fcded0 2011-05-04          matt:                             CHECK or KILLED
ae6dbecf17 2011-05-02          matt:   -runtests tst1,tst2 ... : run tests
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: Run status updates (these require that you are in a test directory
cf78fcded0 2011-05-04          matt:                     and you have sourced the \"megatest.csh\" or
ae6dbecf17 2011-05-02          matt:                     \"megatest.sh\" file.)
ae6dbecf17 2011-05-02          matt:   -step stepname
ae6dbecf17 2011-05-02          matt:   -test-status            : set the state and status of a test (use :state and :status)
ae6dbecf17 2011-05-02          matt:   -setlog logfname        : set the path/filename to the final log relative to the test
ae6dbecf17 2011-05-02          matt:                             directory. may be used with -test-status
00761e1112 2011-05-15          matt:   -set-toplog logfname    : set the overall log for a suite of sub-tests
ae6dbecf17 2011-05-02          matt:   -m comment              : insert a comment for this test
ae6dbecf17 2011-05-02          matt: 
cf78fcded0 2011-05-04          matt: Run data
ae6dbecf17 2011-05-02          matt:   :runname                : required, name for this particular test run
ae6dbecf17 2011-05-02          matt:   :state                  : required if updating step state; e.g. start, end, completed
ae6dbecf17 2011-05-02          matt:   :status                 : required if updating step status; e.g. pass, fail, n/a
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: Queries
ae6dbecf17 2011-05-02          matt:   -list-runs patt         : list runs matching pattern \"patt\", % is the wildcard
c4edfbcd13 2011-05-05      mrwellan:   -testpatt patt          : in list-runs show only these tests, % is the wildcard
c4edfbcd13 2011-05-05      mrwellan:   -itempatt patt          : in list-runs show only tests with items that match patt
ae6dbecf17 2011-05-02          matt:   -showkeys               : show the keys used in this megatest setup
ae6dbecf17 2011-05-02          matt: 
e38c4a9bdd 2011-05-03          matt: Misc
ae6dbecf17 2011-05-02          matt:   -force                  : override some checks
ae6dbecf17 2011-05-02          matt:   -xterm                  : start an xterm instead of launching the test
09102f8425 2011-05-11          matt:   -remove-runs            : remove the data for a run, requires fields, :runname
09102f8425 2011-05-11          matt:                             and -testpatt
09102f8425 2011-05-11          matt:   -testpatt patt          : remove tests matching patt (requires -remove-runs)
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: Helpers
09102f8425 2011-05-11          matt:   -runstep stepname  ...  : take remaining params as comand and execute as stepname
09102f8425 2011-05-11          matt:                             log will be in stepname.log. Best to put command in quotes
ae6dbecf17 2011-05-02          matt:   -logpro file            : with -exec apply logpro file to stepname.log, creates
ae6dbecf17 2011-05-02          matt:                             stepname.html and sets log to same
0add4d5d70 2011-05-06      mrwellan:                             If using make use stepname_logpro.log as your target
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: Called as " (string-intersperse (argv) " ")))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: ;;  -gui                    : start a gui interface
ae6dbecf17 2011-05-02          matt: ;;  -config fname           : override the runconfig file with fname
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: ;; process args
ae6dbecf17 2011-05-02          matt: (define remargs (args:get-args
ae6dbecf17 2011-05-02          matt: 		 (argv)
ae6dbecf17 2011-05-02          matt: 		 (list  "-runtests"  ;; run a specific test
ae6dbecf17 2011-05-02          matt: 			"-config"    ;; override the config file name
ae6dbecf17 2011-05-02          matt: 			"-execute"   ;; run the command encoded in the base64 parameter
ae6dbecf17 2011-05-02          matt: 			"-step"
ae6dbecf17 2011-05-02          matt: 			":runname"
ae6dbecf17 2011-05-02          matt: 			":item"
ae6dbecf17 2011-05-02          matt: 			":runname"
ae6dbecf17 2011-05-02          matt: 			":state"
ae6dbecf17 2011-05-02          matt: 			":status"
ae6dbecf17 2011-05-02          matt: 			"-list-runs"
c4edfbcd13 2011-05-05      mrwellan: 			"-testpatt"
c4edfbcd13 2011-05-05      mrwellan: 			"-itempatt"
ae6dbecf17 2011-05-02          matt: 			"-setlog"
00761e1112 2011-05-15          matt: 			"-set-toplog"
ae6dbecf17 2011-05-02          matt: 			"-runstep"
ae6dbecf17 2011-05-02          matt: 			"-logpro"
e0413b29e1 2011-05-05          matt: 			"-m"
ae6dbecf17 2011-05-02          matt: 			)
ae6dbecf17 2011-05-02          matt: 		 (list  "-h"
ae6dbecf17 2011-05-02          matt: 		        "-force"
ae6dbecf17 2011-05-02          matt: 		        "-xterm"
ae6dbecf17 2011-05-02          matt: 		        "-showkeys"
ae6dbecf17 2011-05-02          matt: 		        "-test-status"
ae6dbecf17 2011-05-02          matt: 		        "-gui"
ae6dbecf17 2011-05-02          matt: 			"-runall"    ;; run all tests
09102f8425 2011-05-11          matt: 			"-remove-runs"
ae6dbecf17 2011-05-02          matt: 		       )
ae6dbecf17 2011-05-02          matt: 		 args:arg-hash
ae6dbecf17 2011-05-02          matt: 		 0))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (if (args:get-arg "-h")
ae6dbecf17 2011-05-02          matt:     (begin
ae6dbecf17 2011-05-02          matt:       (print help)
ae6dbecf17 2011-05-02          matt:       (exit)))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (include "keys.scm")
ae6dbecf17 2011-05-02          matt: (include "items.scm")
ae6dbecf17 2011-05-02          matt: (include "db.scm")
ae6dbecf17 2011-05-02          matt: (include "configf.scm")
ae6dbecf17 2011-05-02          matt: (include "process.scm")
ae6dbecf17 2011-05-02          matt: (include "launch.scm")
ae6dbecf17 2011-05-02          matt: (include "runs.scm")
ae6dbecf17 2011-05-02          matt: ;; (include "gui.scm")
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (define *didsomething* #f)
5411a1be29 2011-05-11      mrwellan: 
5411a1be29 2011-05-11      mrwellan: ;;======================================================================
5411a1be29 2011-05-11      mrwellan: ;; Remove old run(s)
5411a1be29 2011-05-11      mrwellan: ;;======================================================================
5411a1be29 2011-05-11      mrwellan: 
5411a1be29 2011-05-11      mrwellan: (define (remove-runs)
5411a1be29 2011-05-11      mrwellan:   (cond
5411a1be29 2011-05-11      mrwellan:    ((not (args:get-arg ":runname"))
5411a1be29 2011-05-11      mrwellan:     (print "ERROR: Missing required parameter for -remove-runs, you must specify the run name pattern with :runname patt")
5411a1be29 2011-05-11      mrwellan:     (exit 2))
5411a1be29 2011-05-11      mrwellan:    ((not (args:get-arg "-testpatt"))
5411a1be29 2011-05-11      mrwellan:     (print "ERROR: Missing required parameter for -remove-runs, you must specify the test pattern with -testpatt")
5411a1be29 2011-05-11      mrwellan:     (exit 3))
5411a1be29 2011-05-11      mrwellan:    ((not (args:get-arg "-itempatt"))
5411a1be29 2011-05-11      mrwellan:     (print "ERROR: Missing required parameter for -remove-runs, you must specify the items with -itempatt")
5411a1be29 2011-05-11      mrwellan:     (exit 4))
5411a1be29 2011-05-11      mrwellan:    ((let ((db #f))
5411a1be29 2011-05-11      mrwellan:       (if (not (setup-for-run))
5411a1be29 2011-05-11      mrwellan: 	  (begin
5411a1be29 2011-05-11      mrwellan: 	    (print "Failed to setup, exiting")
5411a1be29 2011-05-11      mrwellan: 	    (exit 1)))
5411a1be29 2011-05-11      mrwellan:       (set! db (open-db))
5411a1be29 2011-05-11      mrwellan:       (if (not (car *configinfo*))
5411a1be29 2011-05-11      mrwellan: 	  (begin
5411a1be29 2011-05-11      mrwellan: 	    (print "ERROR: Attempted to remove test(s) but run area config file not found")
5411a1be29 2011-05-11      mrwellan: 	    (exit 1))
5411a1be29 2011-05-11      mrwellan: 	  ;; put test parameters into convenient variables
5411a1be29 2011-05-11      mrwellan: 	  (runs:remove-runs db
5411a1be29 2011-05-11      mrwellan: 			    (args:get-arg ":runname")
5411a1be29 2011-05-11      mrwellan: 			    (args:get-arg "-testpatt")
5411a1be29 2011-05-11      mrwellan: 			    (args:get-arg "-itempatt")))
5411a1be29 2011-05-11      mrwellan:       (sqlite3:finalize! db)
5411a1be29 2011-05-11      mrwellan:       (set! *didsomething* #t)))))
5411a1be29 2011-05-11      mrwellan: 
5411a1be29 2011-05-11      mrwellan: (if (args:get-arg "-remove-runs")
5411a1be29 2011-05-11      mrwellan:     (remove-runs))
c4edfbcd13 2011-05-05      mrwellan: 
c4edfbcd13 2011-05-05      mrwellan: ;;======================================================================
ae6dbecf17 2011-05-02          matt: ;; Query runs
ae6dbecf17 2011-05-02          matt: ;;======================================================================
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (if (args:get-arg "-list-runs")
ae6dbecf17 2011-05-02          matt:     (let* ((db       (begin
ae6dbecf17 2011-05-02          matt: 		       (setup-for-run)
ae6dbecf17 2011-05-02          matt: 		       (open-db)))
ae6dbecf17 2011-05-02          matt: 	   (runpatt  (args:get-arg "-list-runs"))
c4edfbcd13 2011-05-05      mrwellan: 	   (testpatt (args:get-arg "-testpatt"))
c4edfbcd13 2011-05-05      mrwellan: 	   (itempatt (args:get-arg "-itempatt"))
ae6dbecf17 2011-05-02          matt: 	   (runsdat  (db-get-runs db runpatt))
ae6dbecf17 2011-05-02          matt: 	   (runs     (db:get-rows runsdat))
ae6dbecf17 2011-05-02          matt: 	   (header   (db:get-header runsdat))
ae6dbecf17 2011-05-02          matt: 	   (keys     (db-get-keys db))
ae6dbecf17 2011-05-02          matt: 	   (keynames (map key:get-fieldname keys)))
ae6dbecf17 2011-05-02          matt:       ;; Each run
ae6dbecf17 2011-05-02          matt:       (for-each
ae6dbecf17 2011-05-02          matt:        (lambda (run)
ae6dbecf17 2011-05-02          matt: 	 (print "Run: "
ae6dbecf17 2011-05-02          matt: 		(string-intersperse (map (lambda (x)
ae6dbecf17 2011-05-02          matt: 					   (db-get-value-by-header run header x))
ae6dbecf17 2011-05-02          matt: 					 keynames) "/")
ae6dbecf17 2011-05-02          matt: 		"/"
ae6dbecf17 2011-05-02          matt: 		(db-get-value-by-header run header "runname"))
ae6dbecf17 2011-05-02          matt: 	 (let ((run-id (db-get-value-by-header run header "id")))
c4edfbcd13 2011-05-05      mrwellan: 	   (let ((tests (db-get-tests-for-run db run-id testpatt itempatt)))
ae6dbecf17 2011-05-02          matt: 	     ;; Each test
ae6dbecf17 2011-05-02          matt: 	     (for-each
ae6dbecf17 2011-05-02          matt: 	      (lambda (test)
ae6dbecf17 2011-05-02          matt: 		(format #t
ae6dbecf17 2011-05-02          matt: 			"  Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
ae6dbecf17 2011-05-02          matt: 			(conc (db:test-get-testname test)
ae6dbecf17 2011-05-02          matt: 			      (if (equal? (db:test-get-item-path test) "")
ae6dbecf17 2011-05-02          matt: 				  ""
ae6dbecf17 2011-05-02          matt: 				  (conc "(" (db:test-get-item-path test) ")")))
ae6dbecf17 2011-05-02          matt: 			(db:test-get-state test)
ae6dbecf17 2011-05-02          matt: 			(db:test-get-status test)
ae6dbecf17 2011-05-02          matt: 			(db:test-get-run_duration test)
ae6dbecf17 2011-05-02          matt: 			(db:test-get-event_time test)
ae6dbecf17 2011-05-02          matt: 			(db:test-get-host test))
ae6dbecf17 2011-05-02          matt:  		(if (not (or (equal? (db:test-get-status test) "PASS")
ae6dbecf17 2011-05-02          matt: 			     (equal? (db:test-get-state test) "NOT_STARTED")))
ae6dbecf17 2011-05-02          matt: 		    (begin
ae6dbecf17 2011-05-02          matt: 		      (print "         cpuload:  " (db:test-get-cpuload test)
ae6dbecf17 2011-05-02          matt: 			     "\n         diskfree: " (db:test-get-diskfree test)
ae6dbecf17 2011-05-02          matt: 			     "\n         uname:    " (db:test-get-uname test)
ae6dbecf17 2011-05-02          matt: 			     "\n         rundir:   " (db:test-get-rundir test)
ae6dbecf17 2011-05-02          matt: 			     )
ae6dbecf17 2011-05-02          matt: 		      ;; Each test
ae6dbecf17 2011-05-02          matt: 		      (let ((steps (db-get-test-steps-for-run db (db:test-get-id test))))
ae6dbecf17 2011-05-02          matt: 			(for-each
ae6dbecf17 2011-05-02          matt: 			 (lambda (step)
ae6dbecf17 2011-05-02          matt: 			   (format #t
ae6dbecf17 2011-05-02          matt: 				   "    Step: ~20a State: ~10a Status: ~10a Time ~22a\n"
ae6dbecf17 2011-05-02          matt: 				   (db:step-get-stepname step)
ae6dbecf17 2011-05-02          matt: 				   (db:step-get-state step)
ae6dbecf17 2011-05-02          matt: 				   (db:step-get-status step)
ae6dbecf17 2011-05-02          matt: 				   (db:step-get-event_time step)))
ae6dbecf17 2011-05-02          matt: 			;;    (print "    Step: " (db:step-get-stepname step)
ae6dbecf17 2011-05-02          matt: 			;; 	  " " (db:step-get-state step)
ae6dbecf17 2011-05-02          matt: 			;; 	  " " (db:step-get-status step)
ae6dbecf17 2011-05-02          matt: 			;; 	  " " (db:step-get-event_time step)))
ae6dbecf17 2011-05-02          matt: 			 steps)))))
ae6dbecf17 2011-05-02          matt: 		tests))))
ae6dbecf17 2011-05-02          matt:        runs)
ae6dbecf17 2011-05-02          matt:       (set! *didsomething* #t)
ae6dbecf17 2011-05-02          matt:       ))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: ;;======================================================================
ae6dbecf17 2011-05-02          matt: ;; full run
ae6dbecf17 2011-05-02          matt: ;;======================================================================
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: ;; get lock in db for full run for this directory
ae6dbecf17 2011-05-02          matt: ;; for all tests with deps
ae6dbecf17 2011-05-02          matt: ;;   walk tree of tests to find head tasks
ae6dbecf17 2011-05-02          matt: ;;   add head tasks to task queue
ae6dbecf17 2011-05-02          matt: ;;   add dependant tasks to task queue
ae6dbecf17 2011-05-02          matt: ;;   add remaining tasks to task queue
ae6dbecf17 2011-05-02          matt: ;; for each task in task queue
ae6dbecf17 2011-05-02          matt: ;;   if have adequate resources
ae6dbecf17 2011-05-02          matt: ;;     launch task
ae6dbecf17 2011-05-02          matt: ;;   else
ae6dbecf17 2011-05-02          matt: ;;     put task in deferred queue
ae6dbecf17 2011-05-02          matt: ;; if still ok to run tasks
ae6dbecf17 2011-05-02          matt: ;;   process deferred tasks per above steps
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: ;; run all tests are are Not COMPLETED and PASS or CHECK
ae6dbecf17 2011-05-02          matt: (if (args:get-arg "-runall")
ae6dbecf17 2011-05-02          matt:     (if (not (args:get-arg ":runname"))
ae6dbecf17 2011-05-02          matt: 	(begin
ae6dbecf17 2011-05-02          matt: 	  (print "ERROR: Missing required parameter for -runtests, you must specify the run name with :runname runname")
ae6dbecf17 2011-05-02          matt: 	  (exit 2))
ae6dbecf17 2011-05-02          matt: 	(let* ((db      (if (setup-for-run)
ae6dbecf17 2011-05-02          matt: 			    (open-db)
ae6dbecf17 2011-05-02          matt: 			    (begin
ae6dbecf17 2011-05-02          matt: 			      (print "Failed to setup, exiting")
ae6dbecf17 2011-05-02          matt: 			      (exit 1)))))
ae6dbecf17 2011-05-02          matt: 	  (if (not (car *configinfo*))
ae6dbecf17 2011-05-02          matt: 	      (begin
ae6dbecf17 2011-05-02          matt: 		(print "ERROR: Attempted to run a test but run area config file not found")
ae6dbecf17 2011-05-02          matt: 		(exit 1))
ae6dbecf17 2011-05-02          matt: 	      ;; put test parameters into convenient variables
ae6dbecf17 2011-05-02          matt: 	      (let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored for now
ae6dbecf17 2011-05-02          matt: 		(print "INFO: Attempting to start the following tests...")
ae6dbecf17 2011-05-02          matt: 		(print "     " (string-intersperse test-names ","))
ae6dbecf17 2011-05-02          matt: 		(run-tests db test-names)))
ae6dbecf17 2011-05-02          matt: 	  (run-waiting-tests db)
ae6dbecf17 2011-05-02          matt: 	  (sqlite3:finalize! db)
ae6dbecf17 2011-05-02          matt: 	  (set! *didsomething* #t))))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: ;;======================================================================
ae6dbecf17 2011-05-02          matt: ;; run one test
ae6dbecf17 2011-05-02          matt: ;;======================================================================
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: ;; 1. find the config file
ae6dbecf17 2011-05-02          matt: ;; 2. change to the test directory
ae6dbecf17 2011-05-02          matt: ;; 3. update the db with "test started" status, set running host
ae6dbecf17 2011-05-02          matt: ;; 4. process launch the test
ae6dbecf17 2011-05-02          matt: ;;    - monitor the process, update stats in the db every 2^n minutes
ae6dbecf17 2011-05-02          matt: ;; 5. as the test proceeds internally it calls megatest as each step is
ae6dbecf17 2011-05-02          matt: ;;    started and completed
ae6dbecf17 2011-05-02          matt: ;;    - step started, timestamp
ae6dbecf17 2011-05-02          matt: ;;    - step completed, exit status, timestamp
ae6dbecf17 2011-05-02          matt: ;; 6. test phone home
ae6dbecf17 2011-05-02          matt: ;;    - if test run time > allowed run time then kill job
ae6dbecf17 2011-05-02          matt: ;;    - if cannot access db > allowed disconnect time then kill job
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (define (runtests)
ae6dbecf17 2011-05-02          matt:   (if (not (args:get-arg ":runname"))
ae6dbecf17 2011-05-02          matt:       (begin
ae6dbecf17 2011-05-02          matt: 	(print "ERROR: Missing required parameter for -runtests, you must specify the run name with :runname runname")
ae6dbecf17 2011-05-02          matt: 	(exit 2))
ae6dbecf17 2011-05-02          matt:       (let ((db #f))
ae6dbecf17 2011-05-02          matt: 	(if (not (setup-for-run))
ae6dbecf17 2011-05-02          matt: 	    (begin
ae6dbecf17 2011-05-02          matt: 	      (print "Failed to setup, exiting")
ae6dbecf17 2011-05-02          matt: 	      (exit 1)))
ae6dbecf17 2011-05-02          matt: 	(set! db (open-db))
ae6dbecf17 2011-05-02          matt: 	(if (not (car *configinfo*))
ae6dbecf17 2011-05-02          matt: 	    (begin
ae6dbecf17 2011-05-02          matt: 	      (print "ERROR: Attempted to run a test but run area config file not found")
ae6dbecf17 2011-05-02          matt: 	      (exit 1))
ae6dbecf17 2011-05-02          matt: 	    ;; put test parameters into convenient variables
ae6dbecf17 2011-05-02          matt: 	    (let* ((test-names   (string-split (args:get-arg "-runtests") ",")))
ae6dbecf17 2011-05-02          matt: 	      (run-tests db test-names)))
ae6dbecf17 2011-05-02          matt: 	;; run-waiting-tests db)
ae6dbecf17 2011-05-02          matt: 	(sqlite3:finalize! db)
ae6dbecf17 2011-05-02          matt: 	(run-waiting-tests #f)
ae6dbecf17 2011-05-02          matt: 	(set! *didsomething* #t))))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (if (args:get-arg "-runtests")
ae6dbecf17 2011-05-02          matt:     (runtests))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: ;;======================================================================
ae6dbecf17 2011-05-02          matt: ;; execute the test
ae6dbecf17 2011-05-02          matt: ;;    - gets called on remote host
ae6dbecf17 2011-05-02          matt: ;;    - receives info from the -execute param
ae6dbecf17 2011-05-02          matt: ;;    - passes info to steps via MT_CMDINFO env var (future is to use a dot file)
ae6dbecf17 2011-05-02          matt: ;;    - gathers host info and
ae6dbecf17 2011-05-02          matt: ;;======================================================================
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (if (args:get-arg "-execute")
ae6dbecf17 2011-05-02          matt:     (let* ((cmdinfo   (read (open-input-string (base64:base64-decode (args:get-arg "-execute"))))))
ae6dbecf17 2011-05-02          matt:       (setenv "MT_CMDINFO" (args:get-arg "-execute"))
ae6dbecf17 2011-05-02          matt:       (if (list? cmdinfo) ;; ((testpath /tmp/mrwellan/jazzmind/src/example_run/tests/sqlitespeed) (test-name sqlitespeed) (runscript runscript.rb) (db-host localhost) (run-id 1))
ae6dbecf17 2011-05-02          matt: 	  (let* ((testpath  (assoc/default 'testpath  cmdinfo))
ae6dbecf17 2011-05-02          matt: 		 (work-area (assoc/default 'work-area cmdinfo))
ae6dbecf17 2011-05-02          matt: 		 (test-name (assoc/default 'test-name cmdinfo))
ae6dbecf17 2011-05-02          matt: 		 (runscript (assoc/default 'runscript cmdinfo))
ae6dbecf17 2011-05-02          matt: 		 (db-host   (assoc/default 'db-host   cmdinfo))
ae6dbecf17 2011-05-02          matt: 		 (run-id    (assoc/default 'run-id    cmdinfo))
ae6dbecf17 2011-05-02          matt: 		 (itemdat   (assoc/default 'itemdat   cmdinfo))
5c3fd5b583 2011-05-25      mrwellan: 		 (env-ovrd  (assoc/default 'env-ovrd  cmdinfo))
89a6bb7363 2011-05-08          matt: 		 (runname   (assoc/default 'runname   cmdinfo))
00761e1112 2011-05-15          matt: 		 (megatest  (assoc/default 'megatest  cmdinfo))
e38c4a9bdd 2011-05-03          matt: 		 (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo))
ae6dbecf17 2011-05-02          matt: 		 (fullrunscript (conc testpath "/" runscript))
ae6dbecf17 2011-05-02          matt: 		 (db        #f))
ae6dbecf17 2011-05-02          matt: 	    (print "Exectuing " test-name " on " (get-host-name))
ae6dbecf17 2011-05-02          matt: 	    (change-directory testpath)
c5d5ee467e 2011-05-09      mrwellan: 	    (setenv "MT_TEST_RUN_DIR" work-area)
89a6bb7363 2011-05-08          matt: 	    (setenv "MT_TEST_NAME" test-name)
89a6bb7363 2011-05-08          matt: 	    (setenv "MT_ITEM_INFO" (conc itemdat))
89a6bb7363 2011-05-08          matt: 	    (setenv "MT_RUNNAME"   runname)
00761e1112 2011-05-15          matt: 	    (setenv "MT_MEGATEST"  megatest)
e38c4a9bdd 2011-05-03          matt: 	    (setenv "PATH" (conc (getenv "PATH") ":" mt-bindir-path))
00761e1112 2011-05-15          matt: 
ae6dbecf17 2011-05-02          matt: 	    (if (not (setup-for-run))
ae6dbecf17 2011-05-02          matt: 		(begin
ae6dbecf17 2011-05-02          matt: 		  (print "Failed to setup, exiting")
ae6dbecf17 2011-05-02          matt: 		  (exit 1)))
ae6dbecf17 2011-05-02          matt: 	    ;; now can find our db
ae6dbecf17 2011-05-02          matt: 	    (set! db (open-db))
ae6dbecf17 2011-05-02          matt: 	    (change-directory work-area)
ae6dbecf17 2011-05-02          matt: 	    (let ((runconfigf (conc  *toppath* "/runconfigs.config")))
ae6dbecf17 2011-05-02          matt: 	      (if (file-exists? runconfigf)
ae6dbecf17 2011-05-02          matt: 		  (setup-env-defaults db runconfigf run-id)
ae6dbecf17 2011-05-02          matt: 		  (print "WARNING: You do not have a run config file: " runconfigf)))
5c3fd5b583 2011-05-25      mrwellan:             ;; environment overrides are done *before* the remaining critical envars.
5c3fd5b583 2011-05-25      mrwellan:             (alist->env-vars env-ovrd)
ae6dbecf17 2011-05-02          matt: 	    (set-megatest-env-vars db run-id)
ae6dbecf17 2011-05-02          matt: 	    (set-item-env-vars itemdat)
ae6dbecf17 2011-05-02          matt:             (save-environment-as-files "megatest")
ae6dbecf17 2011-05-02          matt: 	    (test-set-meta-info db run-id test-name itemdat)
ae6dbecf17 2011-05-02          matt: 	    (test-set-status! db run-id test-name "REMOTEHOSTSTART" "n/a" itemdat (args:get-arg "-m"))
ae6dbecf17 2011-05-02          matt: 	    (if (args:get-arg "-xterm")
ae6dbecf17 2011-05-02          matt: 		(set! fullrunscript "xterm")
ae6dbecf17 2011-05-02          matt:                 (if (not (file-execute-access? fullrunscript))
ae6dbecf17 2011-05-02          matt:                     (system (conc "chmod ug+x " fullrunscript))))
ae6dbecf17 2011-05-02          matt: 	    ;; We are about to actually kick off the test
ae6dbecf17 2011-05-02          matt: 	    ;; so this is a good place to remove the records for
ae6dbecf17 2011-05-02          matt: 	    ;; any previous runs
ae6dbecf17 2011-05-02          matt: 	    ;; (db:test-remove-steps db run-id testname itemdat)
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: 	    ;; from here on out we will open and close the db
ae6dbecf17 2011-05-02          matt: 	    ;; on every access to reduce the probablitiy of
ae6dbecf17 2011-05-02          matt: 	    ;; contention or stuck access on nfs.
ae6dbecf17 2011-05-02          matt: 	    (sqlite3:finalize! db)
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: 	    (let* ((m            (make-mutex))
ae6dbecf17 2011-05-02          matt: 		   (kill-job?    #f)
ae6dbecf17 2011-05-02          matt: 		   (exit-info    (make-vector 3))
ae6dbecf17 2011-05-02          matt: 		   (runit        (lambda ()
ae6dbecf17 2011-05-02          matt: 				   (let-values
ae6dbecf17 2011-05-02          matt: 				    (((pid exit-status exit-code)
ae6dbecf17 2011-05-02          matt: 				      (run-n-wait fullrunscript)))
ae6dbecf17 2011-05-02          matt: 				    (mutex-lock! m)
ae6dbecf17 2011-05-02          matt: 				    (vector-set! exit-info 0 pid)
ae6dbecf17 2011-05-02          matt: 				    (vector-set! exit-info 1 exit-status)
ae6dbecf17 2011-05-02          matt: 				    (vector-set! exit-info 2 exit-code)
ae6dbecf17 2011-05-02          matt: 				    (mutex-unlock! m))))
ae6dbecf17 2011-05-02          matt: 		   (monitorjob   (lambda ()
ae6dbecf17 2011-05-02          matt: 				   (let* ((start-seconds (current-seconds))
ae6dbecf17 2011-05-02          matt: 					  (calc-minutes  (lambda ()
ae6dbecf17 2011-05-02          matt: 							   (inexact->exact
ae6dbecf17 2011-05-02          matt: 							    (round
ae6dbecf17 2011-05-02          matt: 							     (-
ae6dbecf17 2011-05-02          matt: 							      (current-seconds)
ae6dbecf17 2011-05-02          matt: 							      start-seconds))))))
ae6dbecf17 2011-05-02          matt: 				     (let loop ((minutes   (calc-minutes)))
ae6dbecf17 2011-05-02          matt: 				       (let ((db    (open-db)))
ae6dbecf17 2011-05-02          matt: 					 (set! kill-job? (test-get-kill-request db run-id test-name itemdat))
ae6dbecf17 2011-05-02          matt: 					 (test-update-meta-info db run-id test-name itemdat minutes)
ae6dbecf17 2011-05-02          matt: 					 (if kill-job? (process-signal (vector-ref exit-info 0) signal/term))
ae6dbecf17 2011-05-02          matt: 					 (sqlite3:finalize! db)
ae6dbecf17 2011-05-02          matt: 					 (thread-sleep! (+ 8 (random 4))) ;; add some jitter to the call home time to spread out the db accesses
ae6dbecf17 2011-05-02          matt: 					 (loop (calc-minutes)))))))
ae6dbecf17 2011-05-02          matt: 		   (th1          (make-thread monitorjob))
ae6dbecf17 2011-05-02          matt: 		   (th2          (make-thread runit)))
ae6dbecf17 2011-05-02          matt: 	      (thread-start! th1)
ae6dbecf17 2011-05-02          matt: 	      (thread-start! th2)
ae6dbecf17 2011-05-02          matt: 	      (thread-join! th2)
ae6dbecf17 2011-05-02          matt: 	      (mutex-lock! m)
ae6dbecf17 2011-05-02          matt: 	      (set! db (open-db))
772558f8b5 2011-05-06      mrwellan: 	      (let* ((testinfo (db:get-test-info db run-id test-name (item-list->path itemdat))))
ae6dbecf17 2011-05-02          matt: 		(if (not (equal? (db:test-get-state testinfo) "COMPLETED"))
ae6dbecf17 2011-05-02          matt: 		    (begin
ae6dbecf17 2011-05-02          matt: 		      (print "Test NOT logged as COMPLETED, (state=" (db:test-get-state testinfo) "), updating result")
ae6dbecf17 2011-05-02          matt: 		      (test-set-status! db run-id test-name
ae6dbecf17 2011-05-02          matt: 					(if kill-job? "KILLED" "COMPLETED")
ae6dbecf17 2011-05-02          matt: 					(if (vector-ref exit-info 1) ;; look at the exit-status
ae6dbecf17 2011-05-02          matt: 					    (if (eq? (vector-ref exit-info 2) 0)
ae6dbecf17 2011-05-02          matt: 						"PASS"
ae6dbecf17 2011-05-02          matt: 						"FAIL")
ae6dbecf17 2011-05-02          matt: 					    "FAIL") itemdat (args:get-arg "-m")))))
ae6dbecf17 2011-05-02          matt: 	      (mutex-unlock! m)
ae6dbecf17 2011-05-02          matt: 	      ;; (exec-results (cmd-run->list fullrunscript)) ;;  (list ">" (conc test-name "-run.log"))))
ae6dbecf17 2011-05-02          matt: 	      ;; (success      exec-results)) ;; (eq? (cadr exec-results) 0)))
ae6dbecf17 2011-05-02          matt: 	      (print "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area "
ae6dbecf17 2011-05-02          matt: 		     work-area ":\n====\n exit code " (vector-ref exit-info 2) "\n" "====\n")
ae6dbecf17 2011-05-02          matt: 	      (sqlite3:finalize! db)
ae6dbecf17 2011-05-02          matt: 	      (if (not (vector-ref exit-info 1))
ae6dbecf17 2011-05-02          matt: 		  (exit 4)))))
ae6dbecf17 2011-05-02          matt:       (set! *didsomething* #t)))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (if (args:get-arg "-step")
ae6dbecf17 2011-05-02          matt:     (if (not (getenv "MT_CMDINFO"))
ae6dbecf17 2011-05-02          matt: 	(begin
ae6dbecf17 2011-05-02          matt: 	  (print "ERROR: MT_CMDINFO env var not set, -step must be called *inside* a megatest invoked environment!")
ae6dbecf17 2011-05-02          matt: 	  (exit 5))
ae6dbecf17 2011-05-02          matt: 	(let* ((step      (args:get-arg "-step"))
ae6dbecf17 2011-05-02          matt: 	       (cmdinfo   (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
ae6dbecf17 2011-05-02          matt: 	       (testpath  (assoc/default 'testpath  cmdinfo))
ae6dbecf17 2011-05-02          matt: 	       (test-name (assoc/default 'test-name cmdinfo))
ae6dbecf17 2011-05-02          matt: 	       (runscript (assoc/default 'runscript cmdinfo))
ae6dbecf17 2011-05-02          matt: 	       (db-host   (assoc/default 'db-host   cmdinfo))
ae6dbecf17 2011-05-02          matt: 	       (run-id    (assoc/default 'run-id    cmdinfo))
ae6dbecf17 2011-05-02          matt: 	       (itemdat   (assoc/default 'itemdat   cmdinfo))
ae6dbecf17 2011-05-02          matt: 	       (db        #f)
ae6dbecf17 2011-05-02          matt: 	       (state    (args:get-arg ":state"))
ae6dbecf17 2011-05-02          matt: 	       (status   (args:get-arg ":status")))
ae6dbecf17 2011-05-02          matt: 	  (change-directory testpath)
ae6dbecf17 2011-05-02          matt: 	  (if (not (setup-for-run))
ae6dbecf17 2011-05-02          matt: 	      (begin
ae6dbecf17 2011-05-02          matt: 		(print "Failed to setup, exiting")
ae6dbecf17 2011-05-02          matt: 		(exit 1)))
ae6dbecf17 2011-05-02          matt: 	  (set! db (open-db))
ae6dbecf17 2011-05-02          matt: 	  (if (and state status)
1146144d5b 2011-05-05          matt: 	      (teststep-set-status! db run-id test-name step state status itemdat (args:get-arg "-m"))
ae6dbecf17 2011-05-02          matt: 	      (begin
ae6dbecf17 2011-05-02          matt: 		(print "ERROR: You must specify :state and :status with every call to -step")
ae6dbecf17 2011-05-02          matt: 		(exit 6)))
ae6dbecf17 2011-05-02          matt: 	  (sqlite3:finalize! db)
ae6dbecf17 2011-05-02          matt: 	  (set! *didsomething* #t))))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (if (or (args:get-arg "-setlog")       ;; since setting up is so costly lets piggyback on -test-status
00761e1112 2011-05-15          matt: 	(args:get-arg "-set-toplog")
ae6dbecf17 2011-05-02          matt: 	(args:get-arg "-test-status")
ae6dbecf17 2011-05-02          matt: 	(args:get-arg "-runstep"))
ae6dbecf17 2011-05-02          matt:     (if (not (getenv "MT_CMDINFO"))
ae6dbecf17 2011-05-02          matt: 	(begin
ae6dbecf17 2011-05-02          matt: 	  (print "ERROR: MT_CMDINFO env var not set, commands -test-status, -runstep and -setlog must be called *inside* a megatest environment!")
ae6dbecf17 2011-05-02          matt: 	  (exit 5))
adea88835b 2011-05-06      mrwellan: 	(let* ((startingdir (current-directory))
adea88835b 2011-05-06      mrwellan: 	       (cmdinfo   (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
ae6dbecf17 2011-05-02          matt: 	       (testpath  (assoc/default 'testpath  cmdinfo))
ae6dbecf17 2011-05-02          matt: 	       (test-name (assoc/default 'test-name cmdinfo))
ae6dbecf17 2011-05-02          matt: 	       (runscript (assoc/default 'runscript cmdinfo))
ae6dbecf17 2011-05-02          matt: 	       (db-host   (assoc/default 'db-host   cmdinfo))
ae6dbecf17 2011-05-02          matt: 	       (run-id    (assoc/default 'run-id    cmdinfo))
ae6dbecf17 2011-05-02          matt: 	       (itemdat   (assoc/default 'itemdat   cmdinfo))
ae6dbecf17 2011-05-02          matt: 	       (db        #f)
ae6dbecf17 2011-05-02          matt: 	       (state     (args:get-arg ":state"))
ae6dbecf17 2011-05-02          matt: 	       (status    (args:get-arg ":status")))
ae6dbecf17 2011-05-02          matt: 	  (change-directory testpath)
ae6dbecf17 2011-05-02          matt: 	  (if (not (setup-for-run))
ae6dbecf17 2011-05-02          matt: 	      (begin
ae6dbecf17 2011-05-02          matt: 		(print "Failed to setup, exiting")
ae6dbecf17 2011-05-02          matt: 		(exit 1)))
ae6dbecf17 2011-05-02          matt: 	  (set! db (open-db))
ae6dbecf17 2011-05-02          matt: 	  (if (args:get-arg "-setlog")
ae6dbecf17 2011-05-02          matt: 	      (test-set-log! db run-id test-name itemdat (args:get-arg "-setlog")))
00761e1112 2011-05-15          matt: 	  (if (args:get-arg "-set-toplog")
00761e1112 2011-05-15          matt: 	      (test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
0add4d5d70 2011-05-06      mrwellan: 	  (if (args:get-arg "-runstep")
ae6dbecf17 2011-05-02          matt: 	      (if (null? remargs)
ae6dbecf17 2011-05-02          matt: 		  (begin
ae6dbecf17 2011-05-02          matt: 		    (print "ERROR: nothing specified to run!")
ae6dbecf17 2011-05-02          matt: 		    (sqlite3:finalize! db)
ae6dbecf17 2011-05-02          matt: 		    (exit 6))
adea88835b 2011-05-06      mrwellan: 		  (let* ((stepname   (args:get-arg "-runstep"))
adea88835b 2011-05-06      mrwellan: 			 (logprofile (args:get-arg "-logpro"))
adea88835b 2011-05-06      mrwellan: 			 (logfile    (conc stepname ".log"))
ae6dbecf17 2011-05-02          matt: 			 (cmd        (if (null? remargs) #f (car remargs)))
0add4d5d70 2011-05-06      mrwellan: 			 (params     (if cmd (cdr remargs) '()))
0add4d5d70 2011-05-06      mrwellan: 			 (exitstat   #f)
0add4d5d70 2011-05-06      mrwellan: 			 (shell      (last (string-split (get-environment-variable "SHELL") "/")))
0add4d5d70 2011-05-06      mrwellan: 			 (redir      (case (string->symbol shell)
0add4d5d70 2011-05-06      mrwellan: 				       ((tcsh csh ksh)    ">&")
6696dc330f 2011-05-07          matt: 				       ((zsh bash sh ash) "2>&1 >")))
adea88835b 2011-05-06      mrwellan: 			 (fullcmd    (conc "(" (string-intersperse
adea88835b 2011-05-06      mrwellan: 						(cons cmd params) " ")
adea88835b 2011-05-06      mrwellan: 					   ") " redir " " logfile)))
ae6dbecf17 2011-05-02          matt: 		    ;; mark the start of the test
ae6dbecf17 2011-05-02          matt: 		    (test-set-status! db run-id test-name "start" "n/a" itemdat (args:get-arg "-m"))
ae6dbecf17 2011-05-02          matt: 		    ;; close the db
ae6dbecf17 2011-05-02          matt: 		    (sqlite3:finalize! db)
ae6dbecf17 2011-05-02          matt: 		    ;; run the test step
adea88835b 2011-05-06      mrwellan: 		    (print "INFO: Running \"" fullcmd "\"")
adea88835b 2011-05-06      mrwellan: 		    (change-directory startingdir)
adea88835b 2011-05-06      mrwellan: 		    (set! exitstat (system fullcmd)) ;; cmd params))
290c7d7cc8 2011-05-10      mrwellan: 		    (set! *globalexitstatus* exitstat)
adea88835b 2011-05-06      mrwellan: 		    (change-directory testpath)
e38c4a9bdd 2011-05-03          matt: 		    ;; re-open the db
e38c4a9bdd 2011-05-03          matt: 		    (set! db (open-db))
0add4d5d70 2011-05-06      mrwellan: 		    ;; run logpro if applicable ;; (process-run "ls" (list "/foo" "2>&1" "blah.log"))
adea88835b 2011-05-06      mrwellan: 		    (if logprofile
adea88835b 2011-05-06      mrwellan: 			(let* ((htmllogfile (conc stepname ".html"))
290c7d7cc8 2011-05-10      mrwellan: 			       (oldexitstat exitstat)
adea88835b 2011-05-06      mrwellan: 			       (cmd         (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
adea88835b 2011-05-06      mrwellan: 			  (print "INFO: running \"" cmd "\"")
adea88835b 2011-05-06      mrwellan: 			  (change-directory startingdir)
adea88835b 2011-05-06      mrwellan: 			  (set! exitstat (system cmd))
290c7d7cc8 2011-05-10      mrwellan: 			  (set! *globalexitstatus* exitstat) ;; no necessary
adea88835b 2011-05-06      mrwellan: 			  (change-directory testpath)
89a6bb7363 2011-05-08          matt: 			  (test-set-log! db run-id test-name itemdat htmllogfile)))
290c7d7cc8 2011-05-10      mrwellan: 		    (teststep-set-status! db run-id test-name stepname "end" exitstat itemdat (args:get-arg "-m"))
e38c4a9bdd 2011-05-03          matt: 		    (sqlite3:finalize! db)
290c7d7cc8 2011-05-10      mrwellan: 		    (if (not (eq? exitstat 0))
290c7d7cc8 2011-05-10      mrwellan: 			(exit 254)) ;; (exit exitstat) doesn't work?!?
290c7d7cc8 2011-05-10      mrwellan: 		  ;; open the db
290c7d7cc8 2011-05-10      mrwellan: 		  ;; mark the end of the test
290c7d7cc8 2011-05-10      mrwellan: 		  )))
f412143bd2 2011-05-31      mrwellan: 	  (if (args:get-arg "-test-status")
f412143bd2 2011-05-31      mrwellan: 	      (let ((newstatus (cond
f412143bd2 2011-05-31      mrwellan: 				((number? status)       (if (equal? status 0) "PASS" "FAIL"))
f412143bd2 2011-05-31      mrwellan: 				((string->number status)(if (equal? (string->number status) 0) "PASS" "FAIL"))
f412143bd2 2011-05-31      mrwellan: 				(else status))))
f412143bd2 2011-05-31      mrwellan: 		(test-set-status! db run-id test-name state newstatus itemdat (args:get-arg "-m")))
f412143bd2 2011-05-31      mrwellan: 	      (if (and state status)
f412143bd2 2011-05-31      mrwellan: 		  (if (not (args:get-arg "-setlog"))
f412143bd2 2011-05-31      mrwellan: 		      (begin
f412143bd2 2011-05-31      mrwellan: 			(print "ERROR: You must specify :state and :status with every call to -test-status\n" help)
f412143bd2 2011-05-31      mrwellan: 			(sqlite3:finalize! db)
f412143bd2 2011-05-31      mrwellan: 			(exit 6)))))
ae6dbecf17 2011-05-02          matt: 	  (sqlite3:finalize! db)
ae6dbecf17 2011-05-02          matt: 	  (set! *didsomething* #t))))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (if (args:get-arg "-showkeys")
ae6dbecf17 2011-05-02          matt:     (let ((db #f)
ae6dbecf17 2011-05-02          matt: 	  (keys #f))
ae6dbecf17 2011-05-02          matt:       (if (not (setup-for-run))
ae6dbecf17 2011-05-02          matt: 	  (begin
ae6dbecf17 2011-05-02          matt: 	    (print "Failed to setup, exiting")
ae6dbecf17 2011-05-02          matt: 	    (exit 1)))
ae6dbecf17 2011-05-02          matt:       (set! db (open-db))
ae6dbecf17 2011-05-02          matt:       (set! keys (db-get-keys db))
ae6dbecf17 2011-05-02          matt:       (print "Keys: " (string-intersperse (map key:get-fieldname keys) ", "))
ae6dbecf17 2011-05-02          matt:       (sqlite3:finalize! db)
ae6dbecf17 2011-05-02          matt:       (set! *didsomething* #t)))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (if (args:get-arg "-gui")
ae6dbecf17 2011-05-02          matt:     (begin
ae6dbecf17 2011-05-02          matt:       (print "Look at the dashboard for now")
ae6dbecf17 2011-05-02          matt:       ;; (megatest-gui)
ae6dbecf17 2011-05-02          matt:       (set! *didsomething* #t)))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: (if (not *didsomething*)
ae6dbecf17 2011-05-02          matt:     (print help))
290c7d7cc8 2011-05-10      mrwellan: 
290c7d7cc8 2011-05-10      mrwellan: (if (not (eq? *globalexitstatus* 0))
290c7d7cc8 2011-05-10      mrwellan:     (exit *globalexitstatus*))