Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -62,10 +62,12 @@ 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 @@ -78,10 +80,32 @@ 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_meta (id INTEGER PRIMARY KEY, + testname TEXT DEFAULT '', + author TEXT DEFAULT '', + owner TEXT DEFAULT '', + description TEXT DEFAULT '', + reviewed TIMESTAMP, + 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, + 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));") (patch-db db) (patch-db db) ;; yes, need to do it twice BUG FIXME ;; Must do this *after* running patch db (db:set-var db "MEGATEST_VERSION" megatest-version) )) @@ -97,13 +121,13 @@ exn (begin (print "Exception: " exn) (print "ERROR: Possible out of date schema, attempting to add table metadata...") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER, var TEXT, val TEXT, - CONSTRAINT metadat_constraint UNIQUE (var));") - (db:set-var db "MEGATEST_VERSION" 1.17) - ) + CONSTRAINT metadat_constraint UNIQUE (var));") + (if (not (db:get-var db "MEGATEST_VERSION")) + (db:set-var db "MEGATEST_VERSION" 1.17))) (let ((mver (db:get-var db "MEGATEST_VERSION")) (test-meta-def "CREATE TABLE IF NOT EXISTS test_meta (id INTEGER PRIMARY KEY, testname TEXT DEFAULT '', author TEXT DEFAULT '', owner TEXT DEFAULT '', @@ -113,51 +137,48 @@ avg_runtime REAL, avg_disk REAL, tags TEXT DEFAULT '', CONSTRAINT test_meta_constraint UNIQUE (testname));")) (print "Current schema version: " mver " current megatest version: " megatest-version) - (if (not mver) - (begin - (print "Adding megatest-version to metadata") - (sqlite3:execute db (db:set-var db "MEGATEST_VERSION" megatest-version)))) - ;; (if (< mver 1.18) - ;; (begin - ;; (print "Adding tags column to tests table") - ;; (sqlite3:execute db "ALTER TABLE tests ADD COLUMN tags TEXT DEFAULT '';"))) - (if (< mver 1.21) - (begin - (sqlite3:execute db test-meta-def) - (for-each - (lambda (stmt) - (sqlite3:execute db stmt)) - (list - ;; "ALTER TABLE tests ADD COLUMN expected_value REAL;" ;; DO NOT Add a default, we want it to be NULL - ;; "ALTER TABLE tests ADD COLUMN value REAL;" - ;; "ALTER TABLE tests ADD COLUMN tol REAL;" - ;; "ALTER TABLE tests ADD COLUMN tol_perc REAL;" - "ALTER TABLE tests ADD COLUMN first_err TEXT;" - "ALTER TABLE tests ADD COLUMN first_warn TEXT;" - ;; "ALTER TABLE tests ADD COLUMN units TEXT;" - )))) - (if (< mver 1.25) - (begin - (sqlite3:execute db "DROP TABLE test_data;") - (sqlite3:execute db "DROP TABLE test_meta;") - (sqlite3:execute db test-meta-def) - (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY, + (cond + ((not mver) + (print "Adding megatest-version to metadata") ;; Need to recreate the table + (sqlite3:execute db "DROP TABLE IF EXISTS metadat;") + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER, var TEXT, val TEXT, + CONSTRAINT metadat_constraint UNIQUE (var));") + (db:set-var db "MEGATEST_VERSION" 1.17)) + ((< mver 1.21) + (sqlite3:execute db "DROP TABLE IF EXISTS metadat;") + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER, var TEXT, val TEXT, + CONSTRAINT metadat_constraint UNIQUE (var));") + (db:set-var db "MEGATEST_VERSION" 1.21) ;; set before, just in case the changes are already applied + (sqlite3:execute db test-meta-def) + (for-each + (lambda (stmt) + (sqlite3:execute db stmt)) + (list + "ALTER TABLE tests ADD COLUMN first_err TEXT;" + "ALTER TABLE tests ADD COLUMN first_warn TEXT;" + ))) + ((< mver 1.24) + (db:set-var db "MEGATEST_VERSION" 1.24) + (sqlite3:execute db "DROP TABLE IF EXISTS test_data;") + (sqlite3:execute db "DROP TABLE IF EXISTS test_meta;") + (sqlite3:execute db test-meta-def) + (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_value REAL, + expected REAL, tol REAL, units TEXT, comment TEXT DEFAULT '', status TEXT DEFAULT 'n/a', - CONSTRAINT test_data UNIQUE (test_id,category,variable));"))) - (if (< mver megatest-version) - (db:set-var db "MEGATEST_VERSION" megatest-version))))) + CONSTRAINT test_data UNIQUE (test_id,category,variable));")) + ((< mver megatest-version) + (db:set-var db "MEGATEST_VERSION" megatest-version)))))) ;;====================================================================== ;; meta get and set vars ;;====================================================================== @@ -489,17 +510,18 @@ (define-inline (db:test-data-get-id vec) (vector-ref vec 0)) (define-inline (db:test-data-get-test_id vec) (vector-ref vec 1)) (define-inline (db:test-data-get-category vec) (vector-ref vec 2)) (define-inline (db:test-data-get-variable vec) (vector-ref vec 3)) (define-inline (db:test-data-get-value vec) (vector-ref vec 4)) -(define-inline (db:test-data-get-expected_value vec) (vector-ref vec 5)) +(define-inline (db:test-data-get-expected vec) (vector-ref vec 5)) (define-inline (db:test-data-get-tol vec) (vector-ref vec 6)) (define-inline (db:test-data-get-units vec) (vector-ref vec 7)) (define-inline (db:test-data-get-comment vec) (vector-ref vec 8)) (define-inline (db:test-data-get-status vec) (vector-ref vec 9)) (define (db:csv->test-data db test-id csvdata) + (debug:print 4 "test-id " test-id ", csvdata: " csvdata) (let ((csvlist (csv->list (make-csv-reader (open-input-string csvdata) '((strip-leading-whitespace? #t) (strip-trailing-whitespace? #t)) )))) ;; (csv->list csvdata))) (for-each @@ -532,22 +554,22 @@ ((>) (if (> value expected) "pass" "fail")) ((<) (if (< value expected) "pass" "fail")) ((>=) (if (>= value expected) "pass" "fail")) ((<=) (if (<= value expected) "pass" "fail")) (else (conc "ERROR: bad tol comparator " tol)))))) - (sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected_value,tol,units,comment,status) VALUES (?,?,?,?,?,?,?,?,?);" + (sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status) VALUES (?,?,?,?,?,?,?,?,?);" test-id category variable value expected tol units (if comment comment "") status))) csvlist))) ;; get a list of test_data records matching categorypatt (define (db:read-test-data db test-id categorypatt) (let ((res '())) (sqlite3:for-each-row - (lambda (id test_id category variable value expected_value tol units comment status) - (set! res (cons res (vector id test_id category variable value expected_value tol units comment status)))) + (lambda (id test_id category variable value expected tol units comment status) + (set! res (cons res (vector id test_id category variable value expected tol units comment status)))) db - "SELECT id,test_id,category,variable,value,expected_value,tol,units,comment,status FROM test_data WHERE test_id=? AND category LIKE ?;" test-id categorypatt) + "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status FROM test_data WHERE test_id=? AND category LIKE ?;" test-id categorypatt) (reverse res))) (define (db:load-test-data 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)) @@ -767,11 +789,11 @@ (sqlite3:for-each-row (lambda (testname item_path category variable value comment status) (set! curr-test-name testname) (set! test-data (append test-data (list (list testname item_path category variable value comment status))))) db - "SELECT testname,item_path,category,variable,td.value AS value,expected_value,tol,units,td.comment AS comment,td.status AS status FROM test_data AS td INNER JOIN tests ON tests.id=td.test_id WHERE test_id=?;" + "SELECT testname,item_path,category,variable,td.value AS value,expected,tol,units,td.comment AS comment,td.status AS status FROM test_data AS td INNER JOIN tests ON tests.id=td.test_id WHERE test_id=?;" test-id) (if curr-test-name (set! results (append results (list (cons curr-test-name test-data))))) )) test-ids) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -39,14 +39,16 @@ :state : required if updating step state; e.g. start, end, completed :status : required if updating step status; e.g. pass, fail, n/a Values and record errors and warnings -set-values : update or set values in the megatest db - :value : value measured - :expected_value : value expected - :tol : |value-expect| <= tol - :units : name of the units for value, expected_value and tol + :category : set the category field (optional) + :variable : set the variable name (optional) + :value : value measured (required) + :expected : value expected (required) + :tol : |value-expect| <= tol (required, can be <, >, >=, <= or number) + :units : name of the units for value, expected_value etc. (optional) :first_err : record an error message :first_warn : record a warning message Arbitrary test data loading -load-test-data : read test specific data for storage in the test_data table @@ -111,14 +113,16 @@ "-rerun" "-days" "-rename-run" "-to" ;; values and messages + ":category" + ":variable" ":first_err" ":first_warn" ":value" - ":expected_value" + ":expected" ":tol" ":units" ;; misc "-extract-ods" "-debug" ;; for *verbosity* > 2 @@ -649,11 +653,11 @@ ;; could use an assoc list I guess. (otherdata (let ((res (make-hash-table))) (for-each (lambda (key) (if (args:get-arg key) (hash-table-set! res key (args:get-arg key)))) - (list ":value" ":tol" ":expected_value" ":first_err" ":first_warn" ":units")) + (list ":value" ":tol" ":expected" ":first_err" ":first_warn" ":units" ":category" ":variable")) res))) (if (and (args:get-arg "-test-status") (or (not state) (not status))) (begin Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -214,10 +214,29 @@ ;; :first_warn (let ((val (hash-table-ref/default otherdat ":first_warn" #f))) (if val (sqlite3:execute db "UPDATE tests SET first_warn=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path))) + (let ((category (hash-table-ref/default otherdat ":category" "")) + (variable (hash-table-ref/default otherdat ":variable" "")) + (value (hash-table-ref/default otherdat ":value" #f)) + (expected (hash-table-ref/default otherdat ":expected" #f)) + (tol (hash-table-ref/default otherdat ":tol" #f)) + (units (hash-table-ref/default otherdat ":units" ""))) + (debug:print 4 + "category: " category ", variable: " variable ", value: " value + ", expected: " expected ", tol: " tol ", units: " units) + (if (and value expected tol) ;; all three required + (db:csv->test-data db test-id + (conc category "," + variable "," + value "," + expected "," + tol "," + units "," + comment ",")))) + ;; need to update the top test record if PASS or FAIL and this is a subtest (if (and (not (equal? item-path "")) (or (equal? status "PASS") (equal? status "WARN") (equal? status "FAIL") Index: tests/tests/runfirst/main.sh ================================================================== --- tests/tests/runfirst/main.sh +++ tests/tests/runfirst/main.sh @@ -17,8 +17,8 @@ foo,abl,1.2,1.3,0.1 foo,bra,1.2,pass,silly stuff faz,bar,10,8mA,,,"this is a comment" EOF -$MT_MEGATEST -test-status :state COMPLETED :status $? -m "This is a test level comment" :value 0e6 :expected_value 1.1e6 :tol 100e3 +$MT_MEGATEST -test-status :state COMPLETED :status $? -m "This is a test level comment" :value 10e6 :expected_value 1.1e6 :tol 100e3 :category nada :variable sillyvar :units mFarks :comment "This is the value/expected comment" # $MT_MEGATEST -test-status :state COMPLETED :status FAIL