Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -3,11 +3,11 @@ CSCOPTS= SRCFILES = common.scm items.scm launch.scm \ ods.scm runconfig.scm server.scm configf.scm \ db.scm keys.scm margs.scm megatest-version.scm \ - process.scm runs.scm tasks.scm tests.scm + process.scm runs.scm tasks.scm tests.scm GUISRCF = dashboard.scm dashboard-tests.scm dashboard-guimonitor.scm dashboard-main.scm OFILES = $(SRCFILES:%.scm=%.o) GOFILES = $(GUISRCF:%.scm=%.o) @@ -26,10 +26,11 @@ tests.o db.o launch.o runs.o dashboard-tests.o dashboard-guimonitor.o dashboard-main.o monitor.o dashboard.o megatest.o : db_records.scm tests.o runs.o dashboard.o dashboard-tests.o dashboard-main.o : run_records.scm db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm tests.o tasks.o dashboard-tasks.o : task_records.scm runs.o : test_records.scm + $(OFILES) $(GOFILES) : common_records.scm %.o : %.scm csc $(CSCOPTS) -c $< Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -85,10 +85,11 @@ run_duration INTEGER DEFAULT 0, comment TEXT DEFAULT '', event_time TIMESTAMP, fail_count INTEGER DEFAULT 0, pass_count INTEGER DEFAULT 0, + archived INTEGER DEFAULT 0, -- 0=no, 1=in progress, 2=yes CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path) );") (sqlite3:execute db "CREATE INDEX tests_index ON tests (run_id, testname);") (sqlite3:execute db "CREATE VIEW runs_tests AS SELECT * FROM runs INNER JOIN tests ON runs.id=tests.run_id;") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_steps @@ -210,11 +211,14 @@ (db:set-var db "MEGATEST_VERSION" 1.29) (sqlite3:execute db "ALTER TABLE test_steps ADD COLUMN logfile TEXT DEFAULT '';") (sqlite3:execute db "ALTER TABLE tests ADD COLUMN shortdir TEXT DEFAULT '';")) ((< mver 1.36) (db:set-var db "MEGATEST_VERSION" 1.36) - (sqlite3:execute db "ALTER TABLER test_meta ADD COLUMN jobgroup TEXT DEFAULT 'default';")) + (sqlite3:execute db "ALTER TABLE test_meta ADD COLUMN jobgroup TEXT DEFAULT 'default';")) + ((< mver 1.37) + (db:set-var db "MEGATEST_VERSION" 1.37) + (sqlite3:execute db "ALTER TABLE tests ADD COLUMN archived INTEGER DEFAULT 0;")) ((< mver megatest-version) (db:set-var db "MEGATEST_VERSION" megatest-version)))))) ;;====================================================================== ;; meta get and set vars @@ -481,11 +485,14 @@ (sqlite3:execute db "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;" rundir run-id testname item-path)) +;;====================================================================== ;; Misc. test related queries +;;====================================================================== + (define (db:test-get-paths-matching db keynames target) (let* ((res '()) (itempatt (if (args:get-arg "-itempatt")(args:get-arg "-itempatt") "%")) (testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%")) (statepatt (if (args:get-arg ":state") (args:get-arg ":state") "%")) @@ -496,10 +503,60 @@ (conc "r." key " like '" val "'")) keynames (string-split target "/")) " AND ")) (qrystr (conc "SELECT t.rundir FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id WHERE " + keystr " AND r.runname LIKE '" runname "' AND item_path LIKE '" itempatt "' AND testname LIKE '" + testpatt "' AND t.state LIKE '" statepatt "' AND t.status LIKE '" statuspatt + "'ORDER BY t.event_time ASC;"))) + (debug:print 3 "qrystr: " qrystr) + (sqlite3:for-each-row + (lambda (p) + (set! res (cons p res))) + db + qrystr) + res)) + +(define (db:test-get-test-records-matching db keynames target) + (let* ((res '()) + (itempatt (if (args:get-arg "-itempatt")(args:get-arg "-itempatt") "%")) + (testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%")) + (statepatt (if (args:get-arg ":state") (args:get-arg ":state") "%")) + (statuspatt (if (args:get-arg ":status") (args:get-arg ":status") "%")) + (runname (if (args:get-arg ":runname") (args:get-arg ":runname") "%")) + (keystr (string-intersperse + (map (lambda (key val) + (conc "r." key " like '" val "'")) + keynames + (string-split target "/")) + " AND ")) + (qrystr (conc "SELECT + t.id + t.run_id + t.testname + t.host + t.cpuload + t.diskfree + t.uname + t.rundir + t.shortdir + t.item_path + t.state + t.status + t.attemptnum + t.final_logf + t.logdat + t.run_duratio + t.comment + t.event_time + t.fail_count + t.pass_count + t.archived + + + + FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id WHERE " keystr " AND r.runname LIKE '" runname "' AND item_path LIKE '" itempatt "' AND testname LIKE '" testpatt "' AND t.state LIKE '" statepatt "' AND t.status LIKE '" statuspatt "'ORDER BY t.event_time ASC;"))) (debug:print 3 "qrystr: " qrystr) (sqlite3:for-each-row Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -1,7 +1,7 @@ ;; Always use two digit decimal ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. (declare (unit megatest-version)) -(define megatest-version 1.36) +(define megatest-version 1.37) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -89,10 +89,12 @@ prior runs with same keys -update-meta : update the tests metadata for all tests -env2file fname : write the environment to fname.csh and fname.sh -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are overwritten by values set in config files. + -archive : archive tests, use -target, :runname, -itempatt and -testpatt + Spreadsheet generation -extract-ods fname.ods : extract an open document spreadsheet from the database -pathmod path : insert path, i.e. path/runame/itempath/logfile.html will clear the field if no rundir/testname/itempath/logfile if it contains forward slashes the path will be converted @@ -162,10 +164,12 @@ "-test-status" "-set-values" "-load-test-data" "-summarize-items" "-gui" + ;; misc + "-archive" ;; queries "-test-paths" ;; get path(s) to a test, ordered by youngest first "-runall" ;; run all tests "-remove-runs" @@ -391,11 +395,11 @@ user)))) ;;====================================================================== ;; Get paths to tests ;;====================================================================== -;; run all tests are are Not COMPLETED and PASS or CHECK +;; Get test paths matching target, runname, testpatt, and itempatt (if (args:get-arg "-test-paths") ;; if we are in a test use the MT_CMDINFO data (if (getenv "MT_CMDINFO") (let* ((startingdir (current-directory)) (cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO"))))) @@ -416,10 +420,58 @@ (exit 1))) (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, giving up on -test-paths, exiting") (exit 1))) + (set! db (open-db)) + (let* ((itempatt (args:get-arg "-itempatt")) + (keys (db-get-keys db)) + (keynames (map key:get-fieldname keys)) + (paths (db:test-get-paths-matching db keynames target))) + (set! *didsomething* #t) + (for-each (lambda (path) + (print path)) + paths))) + ;; else do a general-run-call + (general-run-call + "-test-paths" + "Get paths to tests" + (lambda (db target runname keys keynames keyvallst) + (let* ((itempatt (args:get-arg "-itempatt")) + (paths (db:test-get-paths-matching db keynames target))) + (for-each (lambda (path) + (print path)) + paths)))))) + +;;====================================================================== +;; Archive tests +;;====================================================================== +;; Archive tests matching target, runname, testpatt, and itempatt +(if (args:get-arg "-archive") + ;; if we are in a test use the MT_CMDINFO data + (if (getenv "MT_CMDINFO") + (let* ((startingdir (current-directory)) + (cmdinfo (read (open-input-string (base64:base64-decode (getenv "MT_CMDINFO"))))) + (testpath (assoc/default 'testpath cmdinfo)) + (test-name (assoc/default 'test-name cmdinfo)) + (runscript (assoc/default 'runscript cmdinfo)) + (db-host (assoc/default 'db-host cmdinfo)) + (run-id (assoc/default 'run-id cmdinfo)) + (itemdat (assoc/default 'itemdat cmdinfo)) + (db #f) + (state (args:get-arg ":state")) + (status (args:get-arg ":status")) + (target (args:get-arg "-target"))) + (change-directory testpath) + (if (not target) + (begin + (debug:print 0 "ERROR: -target is required.") + (exit 1))) + (if (not (setup-for-run)) + (begin + (debug:print 0 "Failed to setup, giving up on -archive, exiting") + (exit 1))) (set! db (open-db)) (let* ((itempatt (args:get-arg "-itempatt")) (keys (db-get-keys db)) (keynames (map key:get-fieldname keys)) (paths (db:test-get-paths-matching db keynames target))) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -409,10 +409,12 @@ (let* ((new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/")) (new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique (testdat (db:get-test-info db run-id test-name item-path))) (if (not testdat) (begin + ;; ensure that the path exists before registering the test + (system (conc "mkdir -p " new-test-path)) (register-test db run-id test-name item-path) (set! testdat (db:get-test-info db run-id test-name item-path)))) (change-directory test-path) (case (if force ;; (args:get-arg "-force") 'NOT_STARTED Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -426,5 +426,14 @@ minutes run-id testname item-path))) +;;====================================================================== +;; A R C H I V I N G +;;====================================================================== + +(define (test:archive db test-id) + #f) + +(define (test:archive-tests db keynames target) + #f) ADDED tests/tests/neverrun/testconfig Index: tests/tests/neverrun/testconfig ================================================================== --- /dev/null +++ tests/tests/neverrun/testconfig @@ -0,0 +1,4 @@ +[setup] +runscript idontexist + +