Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -73,10 +73,11 @@ host TEXT DEFAULT 'n/a', cpuload REAL DEFAULT -1, diskfree INTEGER DEFAULT -1, uname TEXT DEFAULT 'n/a', rundir TEXT DEFAULT 'n/a', + shortdir TEXT DEFAULT '', item_path TEXT DEFAULT '', state TEXT DEFAULT 'NOT_STARTED', status TEXT DEFAULT 'FAIL', attemptnum INTEGER DEFAULT 0, final_logf TEXT DEFAULT 'logs/final.log', @@ -84,40 +85,29 @@ run_duration INTEGER DEFAULT 0, comment TEXT DEFAULT '', event_time TIMESTAMP, fail_count INTEGER DEFAULT 0, pass_count INTEGER DEFAULT 0, - first_err TEXT, - first_warn TEXT, 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 (id INTEGER PRIMARY KEY, test_id INTEGER, stepname TEXT, state TEXT DEFAULT 'NOT_STARTED', - status TEXT DEFAULT 'n/a',event_time TIMESTAMP, + status TEXT DEFAULT 'n/a', + event_time TIMESTAMP, comment TEXT DEFAULT '', + logfile TEXT, CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS extradat (id INTEGER PRIMARY KEY, run_id INTEGER, key TEXT, val TEXT);") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER PRIMARY KEY, var TEXT, val TEXT, CONSTRAINT metadat_constraint UNIQUE (var));") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS access_log (id INTEGER PRIMARY KEY, user TEXT, accessed TIMESTAMP, args TEXT);") - (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY, - test_id INTEGER, - category TEXT DEFAULT '', - variable TEXT, - value REAL, - expected REAL, - tol REAL, - units TEXT, - comment TEXT DEFAULT '', - status TEXT DEFAULT 'n/a', - CONSTRAINT test_data UNIQUE (test_id,category,variable));") - (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_meta (id INTEGER PRIMARY KEY, + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_meta (id INTEGER PRIMARY KEY, testname TEXT DEFAULT '', author TEXT DEFAULT '', owner TEXT DEFAULT '', description TEXT DEFAULT '', reviewed TIMESTAMP, @@ -124,11 +114,11 @@ iterated TEXT DEFAULT '', avg_runtime REAL, avg_disk REAL, tags TEXT DEFAULT '', CONSTRAINT test_meta_constraint UNIQUE (testname));") - (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY, + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY, test_id INTEGER, category TEXT DEFAULT '', variable TEXT, value REAL, expected REAL, @@ -205,17 +195,22 @@ value REAL, expected REAL, tol REAL, units TEXT, comment TEXT DEFAULT '', - status TEXT DEFAULT 'n/a', + status TEXT DEFAULT 'n/a',foss CONSTRAINT test_data UNIQUE (test_id,category,variable));") (patch-db)) ((< mver 1.27) (db:set-var db "MEGATEST_VERSION" 1.27) (sqlite3:execute db "ALTER TABLE test_data ADD COLUMN type TEXT DEFAULT '';") (patch-db)) + ((< mver 1.28) + (db:set-var db "MEGATEST_VERSION" 1.28) + (sqlite3:execute db "ALTER TABLE test_steps ADD COLUMN logfile TEXT;") + (sqlite3:execute db "ALTER TABLE tests ADD COLUMN shortdir TEXT DEFAULT '';") + (patch-db)) ((< mver megatest-version) (db:set-var db "MEGATEST_VERSION" megatest-version)))))) ;;====================================================================== ;; meta get and set vars Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -159,11 +159,11 @@ ;; call the command using mt_ezstep (set! script (conc script "mt_ezstep " stepname " " stepcmd "\n")) (debug:print 4 "script: " script) - (teststep-set-status! db run-id test-name stepname "start" "-" itemdat #f) + (teststep-set-status! db run-id test-name stepname "start" "-" itemdat #f #f) ;; now launch (let ((pid (process-run script))) (let processloop ((i 0)) (let-values (((pid-val exit-status exit-code)(process-wait pid #t))) (mutex-lock! m) @@ -174,11 +174,11 @@ (if (eq? pid-val 0) (begin (thread-sleep! 2) (processloop (+ i 1)))) )) - (teststep-set-status! db run-id test-name stepname "end" (vector-ref exit-info 2) itemdat #f) + (teststep-set-status! db run-id test-name stepname "end" (vector-ref exit-info 2) itemdat #f (if logpro-used (conc stepname ".html") "")) (if logpro-used (test-set-log! db run-id test-name itemdat (conc stepname ".html"))) (cond ;; WARN from logpro ((and (eq? (vector-ref exit-info 1) 2) logpro-used) Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -1,6 +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.27) +(define megatest-version 1.28) + Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -405,19 +405,20 @@ (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"))) + (status (args:get-arg ":status")) + (logfile (args:get-arg "-setlog"))) (change-directory testpath) (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (set! db (open-db)) (if (and state status) - (teststep-set-status! db run-id test-name step state status itemdat (args:get-arg "-m")) + (teststep-set-status! db run-id test-name step state status itemdat (args:get-arg "-m") logfile) (begin (debug:print 0 "ERROR: You must specify :state and :status with every call to -step") (exit 6))) (sqlite3:finalize! db) (set! *didsomething* #t)))) @@ -476,11 +477,11 @@ ((zsh bash sh ash) "2>&1 >"))) (fullcmd (conc "(" (string-intersperse (cons cmd params) " ") ") " redir " " logfile))) ;; mark the start of the test - (teststep-set-status! db run-id test-name stepname "start" "n/a" itemdat (args:get-arg "-m")) + (teststep-set-status! db run-id test-name stepname "start" "n/a" itemdat (args:get-arg "-m") logfile) ;; close the db (sqlite3:finalize! db) ;; run the test step (debug:print 2 "INFO: Running \"" fullcmd "\"") (change-directory startingdir) @@ -498,11 +499,11 @@ (change-directory startingdir) (set! exitstat (system cmd)) (set! *globalexitstatus* exitstat) ;; no necessary (change-directory testpath) (test-set-log! db run-id test-name itemdat htmllogfile))) - (teststep-set-status! db run-id test-name stepname "end" exitstat itemdat (args:get-arg "-m")) + (teststep-set-status! db run-id test-name stepname "end" exitstat itemdat (args:get-arg "-m") logfile) (sqlite3:finalize! db) (if (not (eq? exitstat 0)) (exit 254)) ;; (exit exitstat) doesn't work?!? ;; open the db ;; mark the end of the test Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -398,11 +398,11 @@ (if valid-values (if (member item valid-values) item #f) item))) -(define (teststep-set-status! db run-id test-name teststep-name state-in status-in itemdat comment) +(define (teststep-set-status! db run-id test-name teststep-name state-in status-in itemdat comment logfile) (debug:print 4 "run-id: " run-id " test-name: " test-name) (let* ((state (check-valid-items "state" state-in)) (status (check-valid-items "status" status-in)) (item-path (item-list->path itemdat)) (testdat (db:get-test-info db run-id test-name item-path))) @@ -411,13 +411,14 @@ (or (not state)(not status))) (debug:print 0 "WARNING: Invalid " (if status "status" "state") " value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config")) (if testdat (let ((test-id (test:get-id testdat))) + ;; FIXME - this should not update the logfile unless it is specified. (sqlite3:execute db - "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment) VALUES(?,?,?,?,strftime('%s','now'),?);" - test-id teststep-name state-in status-in (if comment comment ""))) + "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,strftime('%s','now'),?,?);" + test-id teststep-name state-in status-in (if comment comment "") (if logfile logfile ""))) (debug:print 0 "ERROR: Can't update " test-name " for run " run-id " -> no such test in db")))) (define (test-get-kill-request db run-id test-name itemdat) (let* ((item-path (item-list->path itemdat)) (testdat (db:get-test-info db run-id test-name item-path)))