Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -431,25 +431,26 @@ #:font "Courier New, -10" #:size "100x100"))) (hash-table-set! widgets "Test Data" (lambda (testdat) ;; (let* ((currval (iup:attribute test-data "VALUE")) ;; "TITLE")) - (fmtstr "~10a~10a~10a~10a~7a~7a~6a~a") ;; category,variable,value,expected,tol,units,comment + (fmtstr "~10a~10a~10a~10a~7a~7a~6a~6a~a") ;; category,variable,value,expected,tol,units,type,comment (newval (string-intersperse (append (list - (format #f fmtstr "Category" "Variable" "Value" "Expected" "Tol" "Status" "Units" "Comment") - (format #f fmtstr "========" "========" "=====" "========" "===" "======" "=====" "=======")) + (format #f fmtstr "Category" "Variable" "Value" "Expected" "Tol" "Status" "Units" "Type" "Comment") + (format #f fmtstr "========" "========" "=====" "========" "===" "======" "=====" "====" "=======")) (map (lambda (x) (format #f fmtstr (db:test-data-get-category x) (db:test-data-get-variable x) (db:test-data-get-value x) (db:test-data-get-expected x) (db:test-data-get-tol x) (db:test-data-get-status x) (db:test-data-get-units x) + (db:test-data-get-type x) (db:test-data-get-comment x))) (db:read-test-data db test-id "%"))) "\n"))) (if (not (equal? currval newval)) (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval))))) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -515,11 +515,11 @@ (open-input-string csvdata) '((strip-leading-whitespace? #t) (strip-trailing-whitespace? #t)) )))) ;; (csv->list csvdata))) (for-each (lambda (csvrow) - (let* ((padded-row (take (append csvrow (list #f #f #f #f #f #f #f #f)) 8)) + (let* ((padded-row (take (append csvrow (list #f #f #f #f #f #f #f #f #f)) 9)) (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 @@ -527,14 +527,15 @@ (comment (list-ref padded-row 6)) (status (let ((s (list-ref padded-row 7))) (if (and (string? s)(or (string-match (regexp "^\\s*$") s) (string-match (regexp "^n/a$") s))) #f - s)))) ;; if specified on the input then use, else calculate + s))) ;; if specified on the input then use, else calculate + (type (list-ref padded-row 8))) ;; look up expected,tol,units from previous best fit test if they are all either #f or '' (debug:print 4 "BEFORE: category: " category " variable: " variable " value: " value - ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment) + ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment " type: " type) (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))) @@ -559,22 +560,22 @@ ((>=) (if (>= value expected) "pass" "fail")) ((<=) (if (<= value expected) "pass" "fail")) (else (conc "ERROR: bad tol comparator " tol)))))) (debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment) - (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))) + (sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status,type) VALUES (?,?,?,?,?,?,?,?,?,?);" + test-id category variable value expected tol units (if comment comment "") status type))) 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 tol units comment status) - (set! res (cons (vector id test_id category variable value expected tol units comment status) res))) + (lambda (id test_id category variable value expected tol units comment status type) + (set! res (cons (vector id test_id category variable value expected tol units comment status type) res))) db - "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt) + "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" 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)) @@ -587,18 +588,19 @@ (begin (debug:print 4 lin) (db:csv->test-data db test-id lin) (loop (read-line)))))) ;; roll up the current results. - (db:test-data-rollup db test-id))) + ;; FIXME: Add the status to + (db:test-data-rollup db test-id #f))) ;; 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) +(define (db:test-data-rollup db test-id status) (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') @@ -605,19 +607,20 @@ WHERE id=?;" test-id test-id test-id) ;; if the test is not FAIL then set status based on the fail and pass counts. (thread-sleep! 1) (sqlite3:execute - db + db ;;; NOTE: Should this be WARN,FAIL? A WARN is not a FAIL????? BUG FIXME "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 + WHEN (SELECT pass_count FROM tests WHERE id=?) > 0 AND + (SELECT status FROM tests WHERE id=?) NOT IN ('WARN','FAIL') THEN 'PASS' ELSE status END WHERE id=?;" - test-id test-id test-id)) + test-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)) Index: db_records.scm ================================================================== --- db_records.scm +++ db_records.scm @@ -65,10 +65,11 @@ (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-inline (db:test-data-get-type vec) (vector-ref vec 10)) ;;====================================================================== ;; S T E P S ;;====================================================================== ;; Run steps Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -140,11 +140,11 @@ (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)) + (db:test-data-rollup db test-id status)) ;; add metadata (need to do this way to avoid SQL injection issues) ;; :first_err ;; (let ((val (hash-table-ref/default otherdat ":first_err" #f))) @@ -160,10 +160,11 @@ (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" "")) + (type (hash-table-ref/default otherdat ":type" "")) (dcomment (hash-table-ref/default otherdat ":comment" ""))) (debug:print 4 "category: " category ", variable: " variable ", value: " value ", expected: " expected ", tol: " tol ", units: " units) (if (and value expected tol) ;; all three required @@ -172,11 +173,12 @@ variable "," value "," expected "," tol "," units "," - dcomment ",")))) + dcomment ",," ;; extra comma for status + type )))) ;; 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") Index: tests/tests/runfirst/main.sh ================================================================== --- tests/tests/runfirst/main.sh +++ tests/tests/runfirst/main.sh @@ -16,9 +16,14 @@ 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 -load-test-data << EOF +cat, var, val, exp, comp, units, comment, status, type +ameas,iout,1.2,1.9,>,Amps,Comment,,meas +EOF $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