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)) 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 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 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 c075ebd51b 2011-06-16 mrwellan: -keepgoing : continue running until no jobs are \"LAUNCHED\" or c075ebd51b 2011-06-16 mrwellan: \"NOT_STARTED\" 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. 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 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" 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" 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" 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") 5411a1be29 2011-05-11 mrwellan: (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))))) 3ca3391a4e 2011-11-26 matt: 3ca3391a4e 2011-11-26 matt: ;;====================================================================== 3ca3391a4e 2011-11-26 matt: ;; run one test 3ca3391a4e 2011-11-26 matt: ;;====================================================================== 3ca3391a4e 2011-11-26 matt: 3ca3391a4e 2011-11-26 matt: ;; 1. find the config file 3ca3391a4e 2011-11-26 matt: ;; 2. change to the test directory 3ca3391a4e 2011-11-26 matt: ;; 3. update the db with "test started" status, set running host 3ca3391a4e 2011-11-26 matt: ;; 4. process launch the test 3ca3391a4e 2011-11-26 matt: ;; - monitor the process, update stats in the db every 2^n minutes 3ca3391a4e 2011-11-26 matt: ;; 5. as the test proceeds internally it calls megatest as each step is 3ca3391a4e 2011-11-26 matt: ;; started and completed 3ca3391a4e 2011-11-26 matt: ;; - step started, timestamp 3ca3391a4e 2011-11-26 matt: ;; - step completed, exit status, timestamp 3ca3391a4e 2011-11-26 matt: ;; 6. test phone home 3ca3391a4e 2011-11-26 matt: ;; - if test run time > allowed run time then kill job 3ca3391a4e 2011-11-26 matt: ;; - if cannot access db > allowed disconnect time then kill job 3ca3391a4e 2011-11-26 matt: 3ca3391a4e 2011-11-26 matt: (if (args:get-arg "-runtests") 3ca3391a4e 2011-11-26 matt: (general-run-call 3ca3391a4e 2011-11-26 matt: "-runtests" 3ca3391a4e 2011-11-26 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))))) fa52f9444d 2011-10-26 mrwellan: fa52f9444d 2011-10-26 mrwellan: ;;====================================================================== fa52f9444d 2011-10-26 mrwellan: ;; Rollup into a run fa52f9444d 2011-10-26 mrwellan: ;;====================================================================== fa52f9444d 2011-10-26 mrwellan: (if (args:get-arg "-rollup") fa52f9444d 2011-10-26 mrwellan: (general-run-call fa52f9444d 2011-10-26 mrwellan: "-rollup" fa52f9444d 2011-10-26 mrwellan: "rollup tests" fa52f9444d 2011-10-26 mrwellan: (lambda (db keys keynames keyvallst) fa52f9444d 2011-10-26 mrwellan: (runs:rollup-run db fa52f9444d 2011-10-26 mrwellan: keys fa52f9444d 2011-10-26 mrwellan: (keys->alist keys "na") fa52f9444d 2011-10-26 mrwellan: (args:get-arg ":runname") fa52f9444d 2011-10-26 mrwellan: user)))) fa52f9444d 2011-10-26 mrwellan: fa52f9444d 2011-10-26 mrwellan: ;;====================================================================== fa52f9444d 2011-10-26 mrwellan: ;; Extract a spreadsheet from the runs database fa52f9444d 2011-10-26 mrwellan: ;;====================================================================== fa52f9444d 2011-10-26 mrwellan: fa52f9444d 2011-10-26 mrwellan: (if (args:get-arg "-extract-ods") fa52f9444d 2011-10-26 mrwellan: (general-run-call fa52f9444d 2011-10-26 mrwellan: "-extract-ods" fa52f9444d 2011-10-26 mrwellan: "Make ods spreadsheet" 1db4f07cc5 2012-01-11 mrwellan: (lambda (db target runname keys keynames keyvallst) fa52f9444d 2011-10-26 mrwellan: (let ((outputfile (args:get-arg "-extract-ods")) fa52f9444d 2011-10-26 mrwellan: (runspatt (args:get-arg ":runname")) fa52f9444d 2011-10-26 mrwellan: (pathmod (args:get-arg "-pathmod")) fa52f9444d 2011-10-26 mrwellan: (keyvalalist (keys->alist keys "%"))) 1db4f07cc5 2012-01-11 mrwellan: (debug:print 2 "Extract ods, outputfile: " outputfile " runspatt: " runspatt " keyvalalist: " keyvalalist) fa52f9444d 2011-10-26 mrwellan: (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) 52120b2140 2011-10-20 mrwellan: (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 52120b2140 2011-10-20 mrwellan: (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))) 52120b2140 2011-10-20 mrwellan: (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)))))
File Annotation