Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -59,10 +59,14 @@ (cond ((number? val) val) ((string? val) (string->number val)) ((symbol? val) (any->number (symbol->string val))) (else #f))) + +(define (any->number-if-possible val) + (let ((num (any->number val))) + (if num num val))) ;;====================================================================== ;; System stuff ;;====================================================================== Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -150,10 +150,11 @@ value REAL, expected_value 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))))) ;;====================================================================== @@ -482,31 +483,118 @@ (sqlite3:execute db (conc "UPDATE test_meta SET " field "=? WHERE testname=?;") value testname)) ;;====================================================================== ;; T E S T D A T A ;;====================================================================== -(define (db:csv->testdata db test-id csvdata) - (let ((csvlist (csv->list csvdata))) +(define (make-db:test-data)(make-vector 10)) +(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-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) + (let ((csvlist (csv->list (make-csv-reader + (open-input-string csvdata) + '((strip-leading-whitespace? #t) + (strip-trailing-whitespace? #t)) )))) ;; (csv->list csvdata))) (for-each (lambda (csvrow) - (apply sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment) VALUES (?,?,?,?,?,?,?);" - test-id (take (append csvrow '("" "" "" "" "" "" "")) 7))) + (let* ((padded-row (take (append csvrow '(#f #f #f #f #f #f #f #f)) 8)) + (category (list-ref padded-row 0)) + (variable (list-ref padded-row 1)) + (value (any->number-if-possible (list-ref padded-row 2))) + (expected (any->number-if-possible (list-ref padded-row 3))) + (tol (any->number-if-possible (list-ref padded-row 4))) ;; >, <, >=, <=, or a number + (units (list-ref padded-row 5)) + (comment (list-ref padded-row 6)) + (status (list-ref padded-row 7))) ;; if specified on the input then use, else calculate + ;; look up expected,tol,units from previous best fit test if they are all either #f or '' + (if (and (or (not expected)(equal? expected "")) + (or (not tol) (equal? expected "")) + (or (not units) (equal? expected ""))) + (let-values (((new-expected new-tol new-units)(db:get-prev-tol-for-test db test-id category variable))) + (set! expected new-expected) + (set! tol new-tol) + (set! units new-units))) + ;; calculate status if NOT specified + (if (and (not status)(number? expected)(number? value)) ;; need expected and value to be numbers + (if (number? tol) ;; if tol is a number then we do the standard comparison + (let ((max-val (+ expected tol)) + (min-val (- expected tol))) + (set! status (if (and (>= value min-val)(<= value max-val)) "pass" "fail"))) + (set! status ;; NB// need to assess each one (i.e. not return operator since need to act if not valid op. + (case (string->symbol tol) ;; tol should be >, <, >=, <= + ((>) (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 (?,?,?,?,?,?,?,?,?);" + 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)))) + 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) + (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)) (test-id (if testdat (db:test-get-id testdat) #f))) - (debug:print 1 "Enter records to insert in the test_data table, seven fields, comma separated per line") + ;; (debug:print 1 "Enter records to insert in the test_data table, seven fields, comma separated per line") (debug:print 4 "itemdat: " itemdat ", test-name: " test-name ", test-id: " test-id) (if test-id (let loop ((lin (read-line))) (if (not (eof-object? lin)) (begin (debug:print 4 lin) - (db:csv->testdata db test-id lin) - (loop (read-line))))))) ) + (db:csv->test-data db test-id lin) + (loop (read-line)))))) + ;; roll up the current results. + (db:test-data-rollup db test-id))) + +;; WARNING: Do NOT call this for the parent test on an iterated test +;; Roll up test_data pass/fail results +;; look at the test_data status field, +;; if all are pass (any case) and the test status is PASS or NULL or '' then set test status to PASS. +;; if one or more are fail (any case) then set test status to PASS, non "pass" or "fail" are ignored +(define (db:test-data-rollup db test-id) + (sqlite3:execute + db + "UPDATE tests + SET fail_count=(SELECT count(id) FROM test_data WHERE test_id=? AND status like 'fail'), + pass_count=(SELECT count(id) FROM test_data WHERE test_id=? AND status like 'pass') + WHERE id=?;" + test-id test-id test-id) + ;; if the test is not FAIL then set status based on the fail and pass counts. + (sleep 1) + (sqlite3:execute + db + "UPDATE tests + SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0 + THEN 'FAIL' + WHEN (SELECT pass_count FROM tests WHERE id=?) > 0 + THEN 'PASS' + ELSE status + END WHERE id=?;" + test-id test-id test-id)) + +(define (db:get-prev-tol-for-test db test-id category variable) + ;; Finish me? + (values #f #f #f)) ;;====================================================================== ;; S T E P S ;;====================================================================== ;; Run steps @@ -571,14 +659,14 @@ (debug:print 4 "record[1]=" (vector-ref record 1) ", startt=" startt ", endt=" endt ", get-status: " (db:step-get-status step)) (if (and (number? startt)(number? endt)) (seconds->hr-min-sec (- endt startt)) "-1")))) - (else (vector-set! record 1 (db:step-get-event_time step))) - (vector-set! record 2 (db:step-get-state step)) - (vector-set! record 3 (db:step-get-status step)) - (vector-set! record 4 (db:step-get-event_time step))) + (else (vector-set! record 1 (db:step-get-event_time step)))) + (vector-set! record 2 (db:step-get-state step)) + (vector-set! record 3 (db:step-get-status step)) + (vector-set! record 4 (db:step-get-event_time step)) (hash-table-set! res (db:step-get-stepname step) record) (debug:print 6 "record(after) = " record "\nid: " (db:step-get-id step) "\nstepname: " (db:step-get-stepname step) "\nstate: " (db:step-get-state step) @@ -675,15 +763,15 @@ (for-each (lambda (test-id) (let ((test-data '()) (curr-test-name #f)) (sqlite3:for-each-row - (lambda (testname item_path category variable value comment) + (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))))) + (set! test-data (append test-data (list (list testname item_path category variable value comment status))))) db - "SELECT testname,item_path,category,variable,test_data.value AS value,expected_value,tol,units,test_data.comment AS comment FROM test_data INNER JOIN tests ON tests.id=test_data.test_id WHERE test_id=?;" + "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=?;" 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 @@ -311,12 +311,11 @@ (if (args:get-arg "-rollup") (general-run-call "-rollup" "rollup tests" (lambda (db keys keynames keyvallst) - (let ((n (args:get-arg "-rollup"))) - (runs:rollup-run db keys))))) + (runs:rollup-run db keys)))) ;;====================================================================== ;; Extract a spreadsheet from the runs database ;;====================================================================== Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -172,10 +172,12 @@ (loop (car tal)(cdr tal)))))))))) (define (test-set-status! db run-id test-name state status itemdat-or-path comment dat) (let* ((real-status status) (item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path))) + (testdat (db:get-test-info db run-id test-name item-path)) + (test-id (if testdat (db:test-get-id testdat) #f)) (otherdat (if dat dat (make-hash-table))) ;; before proceeding we must find out if the previous test (where all keys matched except runname) ;; was WAIVED if this test is FAIL (waived (if (equal? status "FAIL") (let ((prev-test (test:get-previous-test-run-record db run-id test-name item-path))) @@ -195,38 +197,26 @@ ;; update the primary record IF state AND status are defined (if (and state status) (sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;" state real-status run-id test-name item-path)) + + ;; if status is "AUTO" then call rollup + (if (and test-id state status (equal? status "AUTO")) + (db:test-data-rollup db test-id)) + ;; add metadata (need to do this way to avoid SQL injection issues) - ;; :value - (let ((val (hash-table-ref/default otherdat ":value" #f))) - (if val - (sqlite3:execute db "UPDATE tests SET value=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path))) - ;; :expected_value - (let ((val (hash-table-ref/default otherdat ":expected_value" #f))) - (if val - (sqlite3:execute db "UPDATE tests SET expected_value=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path))) - ;; :tol - (let ((val (hash-table-ref/default otherdat ":tol" #f))) - (if val - (sqlite3:execute db "UPDATE tests SET tol=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path))) + ;; :first_err (let ((val (hash-table-ref/default otherdat ":first_err" #f))) (if val (sqlite3:execute db "UPDATE tests SET first_err=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path))) + ;; :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 ((val (hash-table-ref/default otherdat ":units" #f))) - (if val - (sqlite3:execute db "UPDATE tests SET units=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path))) - ;; :tol_perc - (let ((val (hash-table-ref/default otherdat ":tol_perc" #f))) - (if val - (sqlite3:execute db "UPDATE tests SET tol_perc=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path))) ;; 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") ADDED tests/tests/exit_0/main.sh Index: tests/tests/exit_0/main.sh ================================================================== --- /dev/null +++ tests/tests/exit_0/main.sh @@ -0,0 +1,3 @@ +#!/bin/bash + +exit 0 ADDED tests/tests/exit_0/testconfig Index: tests/tests/exit_0/testconfig ================================================================== --- /dev/null +++ tests/tests/exit_0/testconfig @@ -0,0 +1,10 @@ +[setup] +runscript main.sh + +[test_meta] +author matt +owner bob +description This test checks that a multi-lineitem test with mix of pass and non-fail rolls up a PASS + +tags first,single +reviewed 09/10/2011, by Matt ADDED tests/tests/exit_1/main.sh Index: tests/tests/exit_1/main.sh ================================================================== --- /dev/null +++ tests/tests/exit_1/main.sh @@ -0,0 +1,3 @@ +#!/bin/bash + +exit 1 ADDED tests/tests/exit_1/testconfig Index: tests/tests/exit_1/testconfig ================================================================== --- /dev/null +++ tests/tests/exit_1/testconfig @@ -0,0 +1,10 @@ +[setup] +runscript main.sh + +[test_meta] +author matt +owner bob +description This test checks that a multi-lineitem test with mix of pass and non-fail rolls up a PASS + +tags first,single +reviewed 09/10/2011, by Matt ADDED tests/tests/lineitem_fail/main.sh Index: tests/tests/lineitem_fail/main.sh ================================================================== --- /dev/null +++ tests/tests/lineitem_fail/main.sh @@ -0,0 +1,16 @@ +#!/bin/bash + +$MT_MEGATEST -load-test-data << EOF +foo,bar, 1.2, 1.9, > +foo,rab, 1.0e9, 10e9, 1e9 +foo,bla, 1.2, 1.9, < +foo,bal, 1.2, 1.2, < , ,Check for overload +foo,alb, 1.2, 1.2, <= , Amps,This is the high power circuit test +foo,abl, 1.2, 1.3, 0.1 +foo,bra, 1.2, pass, silly stuff +faz,bar, 10, 8mA, , ,"this is a comment" +EOF + +# Needed to force rolling up the results and set the test to COMPLETED +$MT_MEGATEST -test-status :state COMPLETED :status AUTO + ADDED tests/tests/lineitem_fail/testconfig Index: tests/tests/lineitem_fail/testconfig ================================================================== --- /dev/null +++ tests/tests/lineitem_fail/testconfig @@ -0,0 +1,10 @@ +[setup] +runscript main.sh + +[test_meta] +author matt +owner bob +description This test checks that a multi-lineitem test with mix of pass and non-fail rolls up a PASS + +tags first,single +reviewed 09/10/2011, by Matt ADDED tests/tests/lineitem_pass/main.sh Index: tests/tests/lineitem_pass/main.sh ================================================================== --- /dev/null +++ tests/tests/lineitem_pass/main.sh @@ -0,0 +1,16 @@ +#!/bin/bash + +# category variable value expected tol/comp units comment +$MT_MEGATEST -load-test-data << EOF +foo, bar, 1.9, 1.8, > +foo, rab, 1.0e9, 2e9, 1e9 +foo, bla, 1.2, 1.9, < +foo, bal, -1.1, 0, < , , Check for overload +foo, alb, 1.2, 1.2, <= , Amps, This is the high power circuit test +foo, abl, 1.2, 1.3, 0.1 +foo, bra, 1.2, pass, silly stuff +faz, bar, 10, 8mA, , ,"this is a comment" +EOF + +# Needed to force rolling up the results and set the test to COMPLETED +$MT_MEGATEST -test-status :state COMPLETED :status AUTO ADDED tests/tests/lineitem_pass/testconfig Index: tests/tests/lineitem_pass/testconfig ================================================================== --- /dev/null +++ tests/tests/lineitem_pass/testconfig @@ -0,0 +1,10 @@ +[setup] +runscript main.sh + +[test_meta] +author matt +owner bob +description This test checks that a multi-lineitem test with mix of pass and non-fail rolls up a PASS + +tags first,single +reviewed 09/10/2011, by Matt Index: tests/tests/runfirst/main.sh ================================================================== --- tests/tests/runfirst/main.sh +++ tests/tests/runfirst/main.sh @@ -6,8 +6,19 @@ touch ../I_was_here $MT_MEGATEST -runstep wasting_time -logpro wasting_time.logpro "sleep 8;echo all done eh?" -m "This is a test step comment" -$MT_MEGATEST -test-status :state COMPLETED :status $? -m "This is a test level comment" -set-toplog the_top_log.html :value 1e6 :expected_value 1.1e6 :tol 100e3 +$MT_MEGATEST -load-test-data << EOF +foo,bar,1.2,1.9,> +foo,rab,1.0e9,10e9,1e9 +foo,bla,1.2,1.9,< +foo,bal,1.2,1.2,<,,Check for overload +foo,alb,1.2,1.2,<=,Amps,This is the high power circuit test +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 FAIL Index: tests/tests/sqlitespeed/runscript.rb ================================================================== --- tests/tests/sqlitespeed/runscript.rb +++ tests/tests/sqlitespeed/runscript.rb @@ -27,10 +27,12 @@ if status==0 status='pass' else status='fail' end + + record_step("add #{num_records}","end",status)