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*))
File Annotation