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: 
3469edbbf7 2011-10-09          matt: ;; (include "common.scm")
3469edbbf7 2011-10-09          matt: ;; (include "megatest-version.scm")
3469edbbf7 2011-10-09          matt: 
a72100abbd 2011-10-12          matt: (use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 format)
e0c173490e 2011-10-09          matt: (import (prefix sqlite3 sqlite3:))
e0c173490e 2011-10-09          matt: (import (prefix base64 base64:))
e0c173490e 2011-10-09          matt: 
3469edbbf7 2011-10-09          matt: (declare (uses common))
3469edbbf7 2011-10-09          matt: (declare (uses megatest-version))
3469edbbf7 2011-10-09          matt: (declare (uses margs))
3469edbbf7 2011-10-09          matt: (declare (uses runs))
3469edbbf7 2011-10-09          matt: (declare (uses launch))
331e7c90b2 2012-02-24          matt: (declare (uses server))
3469edbbf7 2011-10-09          matt: 
3469edbbf7 2011-10-09          matt: (include "common_records.scm")
e0c173490e 2011-10-09          matt: (include "key_records.scm")
e0c173490e 2011-10-09          matt: (include "db_records.scm")
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
42b834da20 2011-08-02      mrwellan:   -summarize-items        : for an itemized test create a summary html
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
c5b61052dd 2011-10-13          matt:   -target key1/key2/...   : run for key1, key2, etc.
c5b61052dd 2011-10-13          matt:   -reqtarg key1/key2/...  : run for key1, key2, etc. but key1/key2 must be in runconfig
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
ebea00e4bb 2011-08-24      mrwellan: 
ebea00e4bb 2011-08-24      mrwellan: Values and record errors and warnings
ebea00e4bb 2011-08-24      mrwellan:   -set-values             : update or set values in the megatest db
d406fee8c4 2011-09-12          matt:   :category               : set the category field (optional)
d406fee8c4 2011-09-12          matt:   :variable               : set the variable name (optional)
d406fee8c4 2011-09-12          matt:   :value                  : value measured (required)
d406fee8c4 2011-09-12          matt:   :expected               : value expected (required)
d406fee8c4 2011-09-12          matt:   :tol                    : |value-expect| <= tol (required, can be <, >, >=, <= or number)
d406fee8c4 2011-09-12          matt:   :units                  : name of the units for value, expected_value etc. (optional)
dd5766961c 2011-09-06          matt: 
dd5766961c 2011-09-06          matt: Arbitrary test data loading
dd5766961c 2011-09-06          matt:   -load-test-data         : read test specific data for storage in the test_data table
dd5766961c 2011-09-06          matt:                             from standard in. Each line is comma delimited with four
dd5766961c 2011-09-06          matt:                             fields category,variable,value,comment
c4edfbcd13 2011-05-05      mrwellan: 
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
e6213e8dbb 2012-01-27          matt:   -test-paths targpatt    : get the most recent test path(s) matching targpatt e.g. %/%...
e6213e8dbb 2012-01-27          matt:                             returns list sorted by age ascending, see examples below
ae6dbecf17 2011-05-02          matt: 
e38c4a9bdd 2011-05-03          matt: Misc
ae6dbecf17 2011-05-02          matt:   -force                  : override some checks
d73b2c1642 2011-06-27      mrwellan:   -remove-runs            : remove the data for a run, requires all fields be specified
d73b2c1642 2011-06-27      mrwellan:                             and :runname ,-testpatt and -itempatt
09102f8425 2011-05-11          matt:                             and -testpatt
d73b2c1642 2011-06-27      mrwellan:   -rerun FAIL,WARN...     : re-run if called on a test that previously ran (nullified
d73b2c1642 2011-06-27      mrwellan:                             if -keepgoing is also specified)
3bb0b5e9f9 2011-07-19          matt:   -rebuild-db             : bring the database schema up to date
94a65715c9 2011-09-05          matt:   -rollup                 : fill run (set by :runname)  with latest test(s) from
94a65715c9 2011-09-05          matt:                             prior runs with same keys
ebea00e4bb 2011-08-24      mrwellan:   -update-meta            : update the tests metadata for all tests
3cbc9cb854 2011-10-23          matt:   -env2file fname         : write the environment to fname.csh and fname.sh
a9efabed17 2011-10-31          matt:   -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
a9efabed17 2011-10-31          matt:                                  overwritten by values set in config files.
263965f514 2012-01-31          matt:   -archive                : archive tests, use -target, :runname, -itempatt and -testpatt
331e7c90b2 2012-02-24          matt:   -server                 : start the server (reduces contention on megatest.db)
263965f514 2012-01-31          matt: 
3cbc9cb854 2011-10-23          matt: Spreadsheet generation
1db4f07cc5 2012-01-11      mrwellan:   -extract-ods fname.ods  : extract an open document spreadsheet from the database
41350e06ff 2011-10-14          matt:   -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
41350e06ff 2011-10-14          matt:                             will clear the field if no rundir/testname/itempath/logfile
6d0ac02863 2011-10-14      mrwellan:                             if it contains forward slashes the path will be converted
6d0ac02863 2011-10-14      mrwellan:                             to windows style
41350e06ff 2011-10-14          matt: 
e6213e8dbb 2012-01-27          matt: Helpers (these only apply in test run mode)
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
e6213e8dbb 2012-01-27          matt: 
e6213e8dbb 2012-01-27          matt: Examples
e6213e8dbb 2012-01-27          matt: 
e6213e8dbb 2012-01-27          matt: # Get test paths
e6213e8dbb 2012-01-27          matt: megatest -test-paths -target ubuntu/n%/no% :runname w49% -testpatt test_mt%
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"
c5b61052dd 2011-10-13          matt: 			"-target"
c5b61052dd 2011-10-13          matt: 			"-reqtarg"
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"
d73b2c1642 2011-06-27      mrwellan: 			"-rerun"
d7ffcddcac 2011-08-11          matt: 			"-days"
d7ffcddcac 2011-08-11          matt: 			"-rename-run"
d7ffcddcac 2011-08-11          matt: 			"-to"
ebea00e4bb 2011-08-24      mrwellan: 			;; values and messages
d406fee8c4 2011-09-12          matt: 			":category"
d406fee8c4 2011-09-12          matt: 			":variable"
ebea00e4bb 2011-08-24      mrwellan: 			":value"
d406fee8c4 2011-09-12          matt: 			":expected"
ebea00e4bb 2011-08-24      mrwellan: 			":tol"
b2e635cc07 2011-08-24      mrwellan: 			":units"
ebea00e4bb 2011-08-24      mrwellan: 			;; misc
9940aff1c0 2011-09-08      mrwellan: 			"-extract-ods"
41350e06ff 2011-10-14          matt: 			"-pathmod"
1b0a53f5b9 2011-10-09          matt: 			"-env2file"
a9efabed17 2011-10-31          matt: 			"-setvars"
bcc1c96231 2011-07-11      mrwellan: 			"-debug" ;; for *verbosity* > 2
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"
ebea00e4bb 2011-08-24      mrwellan: 			"-set-values"
dd5766961c 2011-09-06          matt: 			"-load-test-data"
42b834da20 2011-08-02      mrwellan: 			"-summarize-items"
ae6dbecf17 2011-05-02          matt: 		        "-gui"
263965f514 2012-01-31          matt: 			;; misc
263965f514 2012-01-31          matt: 			"-archive"
e6213e8dbb 2012-01-27          matt: 			;; queries
e6213e8dbb 2012-01-27          matt: 			"-test-paths" ;; get path(s) to a test, ordered by youngest first
e6213e8dbb 2012-01-27          matt: 
ae6dbecf17 2011-05-02          matt: 			"-runall"    ;; run all tests
09102f8425 2011-05-11          matt: 			"-remove-runs"
c075ebd51b 2011-06-16      mrwellan: 			"-keepgoing"
1ea16b0407 2011-06-28      mrwellan: 			"-usequeue"
3bb0b5e9f9 2011-07-19          matt: 			"-rebuild-db"
d7ffcddcac 2011-08-11          matt: 			"-rollup"
ebea00e4bb 2011-08-24      mrwellan: 			"-update-meta"
331e7c90b2 2012-02-24          matt: 			"-server"
331e7c90b2 2012-02-24          matt: 
bcc1c96231 2011-07-11      mrwellan: 			"-v" ;; verbose 2, more than normal (normal is 1)
bcc1c96231 2011-07-11      mrwellan: 			"-q" ;; quiet 0, errors/warnings only
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: (define *didsomething* #f)
1ea16b0407 2011-06-28      mrwellan: 
1ea16b0407 2011-06-28      mrwellan: ;;======================================================================
1ea16b0407 2011-06-28      mrwellan: ;; Misc setup stuff
1ea16b0407 2011-06-28      mrwellan: ;;======================================================================
bcc1c96231 2011-07-11      mrwellan: 
bcc1c96231 2011-07-11      mrwellan: (set! *verbosity* (cond
bcc1c96231 2011-07-11      mrwellan: 		   ((args:get-arg "-debug")(string->number (args:get-arg "-debug")))
bcc1c96231 2011-07-11      mrwellan: 		   ((args:get-arg "-v")    2)
bcc1c96231 2011-07-11      mrwellan: 		   ((args:get-arg "-q")    0)
bcc1c96231 2011-07-11      mrwellan: 		   (else                   1)))
1b0a53f5b9 2011-10-09          matt: 
1b0a53f5b9 2011-10-09          matt: ;;======================================================================
1b0a53f5b9 2011-10-09          matt: ;; Misc general calls
1b0a53f5b9 2011-10-09          matt: ;;======================================================================
1b0a53f5b9 2011-10-09          matt: 
1b0a53f5b9 2011-10-09          matt: (if (args:get-arg "-env2file")
1b0a53f5b9 2011-10-09          matt:     (begin
1b0a53f5b9 2011-10-09          matt:       (save-environment-as-files (args:get-arg "-env2file"))
1b0a53f5b9 2011-10-09          matt:       (set! *didsomething* #t)))
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: 
d73b2c1642 2011-06-27      mrwellan: ;; since several actions can be specified on the command line the removal
d73b2c1642 2011-06-27      mrwellan: ;; is done first
5411a1be29 2011-05-11      mrwellan: (define (remove-runs)
5411a1be29 2011-05-11      mrwellan:   (cond
5411a1be29 2011-05-11      mrwellan:    ((not (args:get-arg ":runname"))
bcc1c96231 2011-07-11      mrwellan:     (debug:print 0 "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"))
bcc1c96231 2011-07-11      mrwellan:     (debug:print 0 "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
bcc1c96231 2011-07-11      mrwellan: 	    (debug:print 0 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
bcc1c96231 2011-07-11      mrwellan: 	    (debug:print 0 "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")
fe1582c208 2012-01-23          matt:     (general-run-call
fe1582c208 2012-01-23          matt:      "-remove-runs"
fe1582c208 2012-01-23          matt:      "remove runs"
fe1582c208 2012-01-23          matt:      (lambda (db target runname keys keynames keyvallst)
fe1582c208 2012-01-23          matt:        (remove-runs))))
ae6dbecf17 2011-05-02          matt: 
ae6dbecf17 2011-05-02          matt: ;;======================================================================
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"))
2ab4dded8c 2011-09-25          matt: 	   (runsdat  (db:get-runs db runpatt #f #f '()))
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)
bcc1c96231 2011-07-11      mrwellan: 	 (debug:print 2 "Run: "
ae6dbecf17 2011-05-02          matt: 		(string-intersperse (map (lambda (x)
d73b2c1642 2011-06-27      mrwellan: 					   (db:get-value-by-header run header x))
ae6dbecf17 2011-05-02          matt: 					 keynames) "/")
ae6dbecf17 2011-05-02          matt: 		"/"
d73b2c1642 2011-06-27      mrwellan: 		(db:get-value-by-header run header "runname"))
d73b2c1642 2011-06-27      mrwellan: 	 (let ((run-id (db:get-value-by-header run header "id")))
a72100abbd 2011-10-12          matt: 	   (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")
6f9cfc22a7 2011-06-06      mrwellan: 			     (equal? (db:test-get-status test) "WARN")
6f9cfc22a7 2011-06-06      mrwellan: 			     (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
2ab4dded8c 2011-09-25          matt: 		      (let ((steps (db:get-steps-for-test 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: 			 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")
d7ffcddcac 2011-08-11          matt:     (general-run-call
d7ffcddcac 2011-08-11          matt:      "-runall"
d7ffcddcac 2011-08-11          matt:      "run all tests"
3ca3391a4e 2011-11-26          matt:      (lambda (db target runname keys keynames keyvallst)
3ca3391a4e 2011-11-26          matt:        (runs:run-tests db
3ca3391a4e 2011-11-26          matt: 		       target
3ca3391a4e 2011-11-26          matt: 		       runname
3ca3391a4e 2011-11-26          matt: 		       (args:get-arg "-testpatt")
3ca3391a4e 2011-11-26          matt: 		       (args:get-arg "-itempatt")
3ca3391a4e 2011-11-26          matt: 		       user
3ca3391a4e 2011-11-26          matt: 		       (make-hash-table)))))
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: (if (args:get-arg "-runtests")
d7ffcddcac 2011-08-11          matt:   (general-run-call
d7ffcddcac 2011-08-11          matt:    "-runtests"
d7ffcddcac 2011-08-11          matt:    "run a test"
3ca3391a4e 2011-11-26          matt:    (lambda (db target runname keys keynames keyvallst)
3ca3391a4e 2011-11-26          matt:      (runs:run-tests db
3ca3391a4e 2011-11-26          matt: 		     target
3ca3391a4e 2011-11-26          matt: 		     runname
3ca3391a4e 2011-11-26          matt: 		     (args:get-arg "-runtests")
3ca3391a4e 2011-11-26          matt: 		     (args:get-arg "-itempatt")
3ca3391a4e 2011-11-26          matt: 		     user
3ca3391a4e 2011-11-26          matt: 		     (make-hash-table)))))
3ca3391a4e 2011-11-26          matt: 
3ca3391a4e 2011-11-26          matt: ;;======================================================================
331e7c90b2 2012-02-24          matt: ;; Start the server
331e7c90b2 2012-02-24          matt: ;;======================================================================
331e7c90b2 2012-02-24          matt: (if (args:get-arg "-server")
331e7c90b2 2012-02-24          matt:     (let* ((toppath (setup-for-run))
331e7c90b2 2012-02-24          matt: 	   (db      (if toppath (open-db) #f)))
331e7c90b2 2012-02-24          matt:       (if db
331e7c90b2 2012-02-24          matt: 	  (server:start db)
331e7c90b2 2012-02-24          matt: 	  (debug:print 0 "ERROR: Failed to setup for megatest"))))
331e7c90b2 2012-02-24          matt: 
331e7c90b2 2012-02-24          matt: ;;;======================================================================
3ca3391a4e 2011-11-26          matt: ;; Rollup into a run
3ca3391a4e 2011-11-26          matt: ;;======================================================================
3ca3391a4e 2011-11-26          matt: (if (args:get-arg "-rollup")
3ca3391a4e 2011-11-26          matt:     (general-run-call
3ca3391a4e 2011-11-26          matt:      "-rollup"
3ca3391a4e 2011-11-26          matt:      "rollup tests"
3ca3391a4e 2011-11-26          matt:      (lambda (db keys keynames keyvallst)
3ca3391a4e 2011-11-26          matt:        (runs:rollup-run db
3ca3391a4e 2011-11-26          matt: 			keys
3ca3391a4e 2011-11-26          matt: 			(keys->alist keys "na")
3ca3391a4e 2011-11-26          matt: 			(args:get-arg ":runname")
3ca3391a4e 2011-11-26          matt: 			user))))
e6213e8dbb 2012-01-27          matt: 
e6213e8dbb 2012-01-27          matt: ;;======================================================================
e6213e8dbb 2012-01-27          matt: ;; Get paths to tests
e6213e8dbb 2012-01-27          matt: ;;======================================================================
263965f514 2012-01-31          matt: ;; Get test paths matching target, runname, testpatt, and itempatt
e6213e8dbb 2012-01-27          matt: (if (args:get-arg "-test-paths")
502458b88d 2012-01-28      mrwellan:     ;; if we are in a test use the MT_CMDINFO data
502458b88d 2012-01-28      mrwellan:     (if (getenv "MT_CMDINFO")
502458b88d 2012-01-28      mrwellan: 	(let* ((startingdir (current-directory))
502458b88d 2012-01-28      mrwellan: 	       (cmdinfo   (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
502458b88d 2012-01-28      mrwellan: 	       (testpath  (assoc/default 'testpath  cmdinfo))
502458b88d 2012-01-28      mrwellan: 	       (test-name (assoc/default 'test-name cmdinfo))
502458b88d 2012-01-28      mrwellan: 	       (runscript (assoc/default 'runscript cmdinfo))
502458b88d 2012-01-28      mrwellan: 	       (db-host   (assoc/default 'db-host   cmdinfo))
502458b88d 2012-01-28      mrwellan: 	       (run-id    (assoc/default 'run-id    cmdinfo))
502458b88d 2012-01-28      mrwellan: 	       (itemdat   (assoc/default 'itemdat   cmdinfo))
502458b88d 2012-01-28      mrwellan: 	       (db        #f)
502458b88d 2012-01-28      mrwellan: 	       (state     (args:get-arg ":state"))
5e8a00a005 2012-01-29          matt: 	       (status    (args:get-arg ":status"))
29be07e3a4 2012-01-30          matt: 	       (target    (args:get-arg "-target")))
502458b88d 2012-01-28      mrwellan: 	  (change-directory testpath)
5e8a00a005 2012-01-29          matt: 	  (if (not target)
5e8a00a005 2012-01-29          matt: 	      (begin
5e8a00a005 2012-01-29          matt: 		(debug:print 0 "ERROR: -target is required.")
5e8a00a005 2012-01-29          matt: 		(exit 1)))
502458b88d 2012-01-28      mrwellan: 	  (if (not (setup-for-run))
502458b88d 2012-01-28      mrwellan: 	      (begin
502458b88d 2012-01-28      mrwellan: 		(debug:print 0 "Failed to setup, giving up on -test-paths, exiting")
263965f514 2012-01-31          matt: 		(exit 1)))
263965f514 2012-01-31          matt: 	  (set! db (open-db))
263965f514 2012-01-31          matt: 	  (let* ((itempatt (args:get-arg "-itempatt"))
263965f514 2012-01-31          matt: 		 (keys     (db-get-keys db))
263965f514 2012-01-31          matt: 		 (keynames (map key:get-fieldname keys))
263965f514 2012-01-31          matt: 		 (paths    (db:test-get-paths-matching db keynames target)))
263965f514 2012-01-31          matt: 	    (set! *didsomething* #t)
263965f514 2012-01-31          matt: 	    (for-each (lambda (path)
263965f514 2012-01-31          matt: 			(print path))
263965f514 2012-01-31          matt: 		      paths)))
263965f514 2012-01-31          matt: 	;; else do a general-run-call
263965f514 2012-01-31          matt: 	(general-run-call
263965f514 2012-01-31          matt: 	 "-test-paths"
263965f514 2012-01-31          matt: 	 "Get paths to tests"
263965f514 2012-01-31          matt: 	 (lambda (db target runname keys keynames keyvallst)
263965f514 2012-01-31          matt: 	   (let* ((itempatt (args:get-arg "-itempatt"))
263965f514 2012-01-31          matt: 		  (paths    (db:test-get-paths-matching db keynames target)))
263965f514 2012-01-31          matt: 	     (for-each (lambda (path)
263965f514 2012-01-31          matt: 			 (print path))
263965f514 2012-01-31          matt: 		       paths))))))
263965f514 2012-01-31          matt: 
263965f514 2012-01-31          matt: ;;======================================================================
263965f514 2012-01-31          matt: ;; Archive tests
263965f514 2012-01-31          matt: ;;======================================================================
263965f514 2012-01-31          matt: ;; Archive tests matching target, runname, testpatt, and itempatt
263965f514 2012-01-31          matt: (if (args:get-arg "-archive")
263965f514 2012-01-31          matt:     ;; if we are in a test use the MT_CMDINFO data
263965f514 2012-01-31          matt:     (if (getenv "MT_CMDINFO")
263965f514 2012-01-31          matt: 	(let* ((startingdir (current-directory))
263965f514 2012-01-31          matt: 	       (cmdinfo   (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO")))))
263965f514 2012-01-31          matt: 	       (testpath  (assoc/default 'testpath  cmdinfo))
263965f514 2012-01-31          matt: 	       (test-name (assoc/default 'test-name cmdinfo))
263965f514 2012-01-31          matt: 	       (runscript (assoc/default 'runscript cmdinfo))
263965f514 2012-01-31          matt: 	       (db-host   (assoc/default 'db-host   cmdinfo))
263965f514 2012-01-31          matt: 	       (run-id    (assoc/default 'run-id    cmdinfo))
263965f514 2012-01-31          matt: 	       (itemdat   (assoc/default 'itemdat   cmdinfo))
263965f514 2012-01-31          matt: 	       (db        #f)
263965f514 2012-01-31          matt: 	       (state     (args:get-arg ":state"))
263965f514 2012-01-31          matt: 	       (status    (args:get-arg ":status"))
263965f514 2012-01-31          matt: 	       (target    (args:get-arg "-target")))
263965f514 2012-01-31          matt: 	  (change-directory testpath)
263965f514 2012-01-31          matt: 	  (if (not target)
263965f514 2012-01-31          matt: 	      (begin
263965f514 2012-01-31          matt: 		(debug:print 0 "ERROR: -target is required.")
263965f514 2012-01-31          matt: 		(exit 1)))
263965f514 2012-01-31          matt: 	  (if (not (setup-for-run))
263965f514 2012-01-31          matt: 	      (begin
263965f514 2012-01-31          matt: 		(debug:print 0 "Failed to setup, giving up on -archive, exiting")
29be07e3a4 2012-01-30          matt: 		(exit 1)))
29be07e3a4 2012-01-30          matt: 	  (set! db (open-db))
29be07e3a4 2012-01-30          matt: 	  (let* ((itempatt (args:get-arg "-itempatt"))
29be07e3a4 2012-01-30          matt: 		 (keys     (db-get-keys db))
29be07e3a4 2012-01-30          matt: 		 (keynames (map key:get-fieldname keys))
29be07e3a4 2012-01-30          matt: 		 (paths    (db:test-get-paths-matching db keynames target)))
5e8a00a005 2012-01-29          matt: 	    (set! *didsomething* #t)
502458b88d 2012-01-28      mrwellan: 	    (for-each (lambda (path)
502458b88d 2012-01-28      mrwellan: 			(print path))
502458b88d 2012-01-28      mrwellan: 		      paths)))
502458b88d 2012-01-28      mrwellan: 	;; else do a general-run-call
502458b88d 2012-01-28      mrwellan: 	(general-run-call
502458b88d 2012-01-28      mrwellan: 	 "-test-paths"
502458b88d 2012-01-28      mrwellan: 	 "Get paths to tests"
502458b88d 2012-01-28      mrwellan: 	 (lambda (db target runname keys keynames keyvallst)
502458b88d 2012-01-28      mrwellan: 	   (let* ((itempatt (args:get-arg "-itempatt"))
29be07e3a4 2012-01-30          matt: 		  (paths    (db:test-get-paths-matching db keynames target)))
502458b88d 2012-01-28      mrwellan: 	     (for-each (lambda (path)
502458b88d 2012-01-28      mrwellan: 			 (print path))
502458b88d 2012-01-28      mrwellan: 		       paths))))))
1db4f07cc5 2012-01-11      mrwellan: 
1db4f07cc5 2012-01-11      mrwellan: ;;======================================================================
3ca3391a4e 2011-11-26          matt: ;; Extract a spreadsheet from the runs database
3ca3391a4e 2011-11-26          matt: ;;======================================================================
3ca3391a4e 2011-11-26          matt: 
3ca3391a4e 2011-11-26          matt: (if (args:get-arg "-extract-ods")
3ca3391a4e 2011-11-26          matt:     (general-run-call
3ca3391a4e 2011-11-26          matt:      "-extract-ods"
3ca3391a4e 2011-11-26          matt:      "Make ods spreadsheet"
1db4f07cc5 2012-01-11      mrwellan:      (lambda (db target runname keys keynames keyvallst)
3ca3391a4e 2011-11-26          matt:        (let ((outputfile (args:get-arg "-extract-ods"))
3ca3391a4e 2011-11-26          matt: 	     (runspatt   (args:get-arg ":runname"))
3ca3391a4e 2011-11-26          matt: 	     (pathmod    (args:get-arg "-pathmod"))
3ca3391a4e 2011-11-26          matt: 	     (keyvalalist (keys->alist keys "%")))
1db4f07cc5 2012-01-11      mrwellan: 	 (debug:print 2 "Extract ods, outputfile: " outputfile " runspatt: " runspatt " keyvalalist: " keyvalalist)
3ca3391a4e 2011-11-26          matt: 	 (db:extract-ods-file db outputfile keyvalalist (if runspatt runspatt "%") pathmod)))))
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")
37589f80eb 2011-10-09          matt:     (begin
37589f80eb 2011-10-09          matt:       (launch:execute (args:get-arg "-execute"))
bcc1c96231 2011-07-11      mrwellan:       (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
bcc1c96231 2011-07-11      mrwellan: 	  (debug:print 0 "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"))
52120b2140 2011-10-20      mrwellan: 	       (status   (args:get-arg ":status"))
52120b2140 2011-10-20      mrwellan: 	       (logfile  (args:get-arg "-setlog")))
ae6dbecf17 2011-05-02          matt: 	  (change-directory testpath)
ae6dbecf17 2011-05-02          matt: 	  (if (not (setup-for-run))
ae6dbecf17 2011-05-02          matt: 	      (begin
bcc1c96231 2011-07-11      mrwellan: 		(debug:print 0 "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)
331e7c90b2 2012-02-24          matt: 	      (rdb:teststep-set-status! db run-id test-name step state status itemdat (args:get-arg "-m") logfile)
ae6dbecf17 2011-05-02          matt: 	      (begin
bcc1c96231 2011-07-11      mrwellan: 		(debug:print 0 "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")
ebea00e4bb 2011-08-24      mrwellan: 	(args:get-arg "-set-values")
dd5766961c 2011-09-06          matt: 	(args:get-arg "-load-test-data")
42b834da20 2011-08-02      mrwellan: 	(args:get-arg "-runstep")
42b834da20 2011-08-02      mrwellan: 	(args:get-arg "-summarize-items"))
ae6dbecf17 2011-05-02          matt:     (if (not (getenv "MT_CMDINFO"))
ae6dbecf17 2011-05-02          matt: 	(begin
bcc1c96231 2011-07-11      mrwellan: 	  (debug:print 0 "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
bcc1c96231 2011-07-11      mrwellan: 		(debug:print 0 "Failed to setup, exiting")
ae6dbecf17 2011-05-02          matt: 		(exit 1)))
ae6dbecf17 2011-05-02          matt: 	  (set! db (open-db))
dd5766961c 2011-09-06          matt: 	  (if (args:get-arg "-load-test-data")
dd5766961c 2011-09-06          matt: 	      (db:load-test-data db run-id test-name itemdat))
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")))
42b834da20 2011-08-02      mrwellan: 	  (if (args:get-arg "-summarize-items")
40fcb78bd6 2011-08-03          matt: 	      (tests:summarize-items db run-id test-name #t)) ;; do force here
0add4d5d70 2011-05-06      mrwellan: 	  (if (args:get-arg "-runstep")
ae6dbecf17 2011-05-02          matt: 	      (if (null? remargs)
ae6dbecf17 2011-05-02          matt: 		  (begin
bcc1c96231 2011-07-11      mrwellan: 		    (debug:print 0 "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
331e7c90b2 2012-02-24          matt: 		    (rdb:teststep-set-status! db run-id test-name stepname "start" "n/a" itemdat (args:get-arg "-m") logfile)
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
bcc1c96231 2011-07-11      mrwellan: 		    (debug:print 2 "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")) " ")))
bcc1c96231 2011-07-11      mrwellan: 			  (debug:print 2 "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)))
331e7c90b2 2012-02-24          matt: 		    (rdb:teststep-set-status! db run-id test-name stepname "end" exitstat itemdat (args:get-arg "-m") logfile)
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: 		  )))
ebea00e4bb 2011-08-24      mrwellan: 	  (if (or (args:get-arg "-test-status")
ebea00e4bb 2011-08-24      mrwellan: 		  (args:get-arg "-set-values"))
f412143bd2 2011-05-31      mrwellan: 	      (let ((newstatus (cond
f412143bd2 2011-05-31      mrwellan: 				((number? status)       (if (equal? status 0) "PASS" "FAIL"))
ebea00e4bb 2011-08-24      mrwellan: 				((and (string? status)
ebea00e4bb 2011-08-24      mrwellan: 				      (string->number status))(if (equal? (string->number status) 0) "PASS" "FAIL"))
ebea00e4bb 2011-08-24      mrwellan: 				(else status)))
ebea00e4bb 2011-08-24      mrwellan: 		    ;; transfer relevant keys into a hash to be passed to test-set-status!
ebea00e4bb 2011-08-24      mrwellan: 		    ;; could use an assoc list I guess.
ebea00e4bb 2011-08-24      mrwellan: 		    (otherdata (let ((res (make-hash-table)))
ebea00e4bb 2011-08-24      mrwellan: 				 (for-each (lambda (key)
ebea00e4bb 2011-08-24      mrwellan: 					     (if (args:get-arg key)
ebea00e4bb 2011-08-24      mrwellan: 						 (hash-table-set! res key (args:get-arg key))))
d406fee8c4 2011-09-12          matt: 					   (list ":value" ":tol" ":expected" ":first_err" ":first_warn" ":units" ":category" ":variable"))
ebea00e4bb 2011-08-24      mrwellan: 				 res)))
ebea00e4bb 2011-08-24      mrwellan: 		(if (and (args:get-arg "-test-status")
ebea00e4bb 2011-08-24      mrwellan: 			 (or (not state)
ebea00e4bb 2011-08-24      mrwellan: 			     (not status)))
ebea00e4bb 2011-08-24      mrwellan: 		    (begin
ebea00e4bb 2011-08-24      mrwellan: 		      (debug:print 0 "ERROR: You must specify :state and :status with every call to -test-status\n" help)
ebea00e4bb 2011-08-24      mrwellan: 		      (sqlite3:finalize! db)
ebea00e4bb 2011-08-24      mrwellan: 		      (exit 6)))
ebea00e4bb 2011-08-24      mrwellan: 		(test-set-status! db run-id test-name state newstatus itemdat (args:get-arg "-m") otherdata)))
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
bcc1c96231 2011-07-11      mrwellan: 	    (debug:print 0 "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))
bcc1c96231 2011-07-11      mrwellan:       (debug:print 1 "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
bcc1c96231 2011-07-11      mrwellan:       (debug:print 0 "Look at the dashboard for now")
ae6dbecf17 2011-05-02          matt:       ;; (megatest-gui)
3bb0b5e9f9 2011-07-19          matt:       (set! *didsomething* #t)))
3bb0b5e9f9 2011-07-19          matt: 
3bb0b5e9f9 2011-07-19          matt: ;;======================================================================
3bb0b5e9f9 2011-07-19          matt: ;; Update the database schema on request
3bb0b5e9f9 2011-07-19          matt: ;;======================================================================
3bb0b5e9f9 2011-07-19          matt: 
3bb0b5e9f9 2011-07-19          matt: (if (args:get-arg "-rebuild-db")
3bb0b5e9f9 2011-07-19          matt:     (begin
3bb0b5e9f9 2011-07-19          matt:       (if (not (setup-for-run))
3bb0b5e9f9 2011-07-19          matt: 	  (begin
3bb0b5e9f9 2011-07-19          matt: 	    (debug:print 0 "Failed to setup, exiting")
3bb0b5e9f9 2011-07-19          matt: 	    (exit 1)))
3bb0b5e9f9 2011-07-19          matt:       ;; now can find our db
3bb0b5e9f9 2011-07-19          matt:       (set! db (open-db))
3bb0b5e9f9 2011-07-19          matt:       (patch-db db)
ebea00e4bb 2011-08-24      mrwellan:       (sqlite3:finalize! db)
ebea00e4bb 2011-08-24      mrwellan:       (set! *didsomething* #t)))
ebea00e4bb 2011-08-24      mrwellan: 
ebea00e4bb 2011-08-24      mrwellan: ;;======================================================================
ebea00e4bb 2011-08-24      mrwellan: ;; Update the tests meta data from the testconfig files
ebea00e4bb 2011-08-24      mrwellan: ;;
ebea00e4bb 2011-08-24      mrwellan: 
ebea00e4bb 2011-08-24      mrwellan: (if (args:get-arg "-update-meta")
ebea00e4bb 2011-08-24      mrwellan:     (begin
ebea00e4bb 2011-08-24      mrwellan:       (if (not (setup-for-run))
ebea00e4bb 2011-08-24      mrwellan: 	  (begin
ebea00e4bb 2011-08-24      mrwellan: 	    (debug:print 0 "Failed to setup, exiting")
ebea00e4bb 2011-08-24      mrwellan: 	    (exit 1)))
ebea00e4bb 2011-08-24      mrwellan:       ;; now can find our db
ebea00e4bb 2011-08-24      mrwellan:       (set! db (open-db))
ebea00e4bb 2011-08-24      mrwellan:       (runs:update-all-test_meta db)
3bb0b5e9f9 2011-07-19          matt:       (sqlite3:finalize! db)
bcc1c96231 2011-07-11      mrwellan:       (set! *didsomething* #t)))
bcc1c96231 2011-07-11      mrwellan: 
ae6dbecf17 2011-05-02          matt: (if (not *didsomething*)
bcc1c96231 2011-07-11      mrwellan:     (debug:print 0 help))
290c7d7cc8 2011-05-10      mrwellan: 
290c7d7cc8 2011-05-10      mrwellan: (if (not (eq? *globalexitstatus* 0))
d73b2c1642 2011-06-27      mrwellan:     (if (or (args:get-arg "-runtests")(args:get-arg "-runall"))
d73b2c1642 2011-06-27      mrwellan:         (begin
bcc1c96231 2011-07-11      mrwellan:            (debug:print 0 "NOTE: Subprocesses with non-zero exit code detected: " *globalexitstatus*)
d73b2c1642 2011-06-27      mrwellan:            (exit 0))
d73b2c1642 2011-06-27      mrwellan:         (case *globalexitstatus*
d73b2c1642 2011-06-27      mrwellan:          ((0)(exit 0))
d73b2c1642 2011-06-27      mrwellan:          ((1)(exit 1))
d73b2c1642 2011-06-27      mrwellan:          ((2)(exit 2))
d73b2c1642 2011-06-27      mrwellan:          (else (exit 3)))))