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 archive.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 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)))