Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -1,11 +1,13 @@ -FILES=$(glob *.scm) +# $(glob *.scm) did not work as I expected it to!? + +FILES=$(shell ls *.scm) -megatest: common.scm configf.scm db.scm keys.scm launch.scm megatest.scm process.scm runs.scm gui.scm +megatest: $(FILES) csc megatest.scm -dashboard: dashboard.scm dashboard-tests.scm +dashboard: $(FILES) csc dashboard.scm $(PREFIX)/bin/megatest : megatest @echo Installing to PREFIX=$(PREFIX), use ^C to cancel and change sleep 5 Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -47,10 +47,19 @@ (define-inline (debug:print n . params) (if (<= n *verbosity*) (apply print params))) +;; if a value is printable (i.e. string or number) return the value +;; else return an empty string +(define-inline (printable val) + (if (or (number? val)(string? val)) val "")) + +;;====================================================================== +;; System stuff +;;====================================================================== + (define (get-df path) (let* ((df-results (cmd-run->list (conc "df " path))) (space-rx (regexp "([0-9]+)\\s+([0-9]+)%")) (freespc #f)) ;; (write df-results) Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -23,11 +23,15 @@ (list "Testname: " "Item path: " "Current state: " "Current status: " "Test comment: " - "Test id: ")) + "Test id: " + "Value: " + "Expected value: " + "Tolerance: " + "Units: ")) (list (iup:label "" #:expand "VERTICAL")))) (apply iup:vbox ; #:expand "YES" (list (store-label "testname" (iup:label (db:test-get-testname testdat) #:expand "HORIZONTAL") @@ -57,11 +61,32 @@ (db:test-get-comment testdat))) (store-label "testid" (iup:label "TestId " #:expand "HORIZONTAL") (lambda (testdat) - (db:test-get-id testdat)))))))) + (db:test-get-id testdat))) + (store-label "testvalue" + (iup:label "TestValue " + #:expand "HORIZONTAL") + (lambda (testdat) + (db:test-get-value testdat))) + (store-label "testexpectedvalue" + (iup:label "TestExpectedValue " + #:expand "HORIZONTAL") + (lambda (testdat) + (db:test-get-expected_value testdat))) + (store-label "testtol" + (iup:label "TestTol " + #:expand "HORIZONTAL") + (lambda (testdat) + (db:test-get-tol testdat))) + (store-label "testunits" + (iup:label "TestUnits " + #:expand "HORIZONTAL") + (lambda (testdat) + (db:test-get-units testdat))) + ))))) ;;====================================================================== ;; Test meta panel ;;====================================================================== (define (test-meta-panel testmeta store-meta) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -130,10 +130,11 @@ "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 megatest-version) (db:set-var db "MEGATEST_VERSION" megatest-version))))) ;;====================================================================== @@ -280,10 +281,16 @@ (define-inline (db:test-get-run_duration vec) (vector-ref vec 12)) (define-inline (db:test-get-final_logf vec) (vector-ref vec 13)) (define-inline (db:test-get-comment vec) (vector-ref vec 14)) (define-inline (db:test-get-fullname vec) (conc (db:test-get-testname vec) "/" (db:test-get-item-path vec))) +(define-inline (db:test-get-value vec) (printable (vector-ref vec 15))) +(define-inline (db:test-get-expected_value vec)(printable (vector-ref vec 16))) +(define-inline (db:test-get-tol vec) (printable (vector-ref vec 17))) +(define-inline (db:test-get-units vec) (printable (vector-ref vec 18))) +(define-inline (db:test-get-first_err vec) (printable (vector-ref vec 19))) +(define-inline (db:test-get-first_warn vec) (printable (vector-ref vec 20))) (define-inline (db:test-set-testname! vec val)(vector-set! vec 2 val)) (define-inline (db:test-set-state! vec val)(vector-set! vec 3 val)) (define-inline (db:test-set-status! vec val)(vector-set! vec 4 val)) @@ -290,14 +297,14 @@ (define (db-get-tests-for-run db run-id . params) (let ((res '()) (testpatt (if (or (null? params)(not (car params))) "%" (car params))) (itempatt (if (> (length params) 1)(cadr params) "%"))) (sqlite3:for-each-row - (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) - (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res))) + (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment value expected-value tol units first-err first-warn) + (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment value expected-value tol units first-err first-warn) res))) db - "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? ORDER BY id DESC;" + "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,value,expected_value,tol,units,first_err,first_warn FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? ORDER BY id DESC;" run-id testpatt (if itempatt itempatt "%")) res)) ;; this one is a bit broken BUG FIXME (define (db:delete-test-step-records db run-id test-name itemdat) @@ -351,25 +358,25 @@ ;; NB// Sync this with runs:get-test-info (define (db:get-test-info db run-id testname item-path) (let ((res #f)) (sqlite3:for-each-row - (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment) - (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment))) + (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment value expected-value tol units first-err first-warn) + (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment value expected-value tol units first-err first-warn))) db - "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname=? AND item_path=?;" + "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,value,expected_value,tol,units,first_err,first_warn FROM tests WHERE run_id=? AND testname=? AND item_path=?;" run-id testname item-path) res)) ;; Get test data using test_id (define (db:get-test-data-by-id db test-id) (let ((res #f)) (sqlite3:for-each-row - (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment) - (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment))) + (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment value expected-value tol units first-err first-warn) + (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment value expected-value tol units first-err first-warn))) db - "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;" + "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,value,expected_value,tol,units,first_err,first_warn FROM tests WHERE id=?;" test-id) res)) (define (db:test-set-comment db run-id testname item-path comment) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -41,11 +41,12 @@ Values and record errors and warnings -set-values : update or set values in the megatest db :value : value measured :expected_value : value expected - :tol : tolerance |value-expect| <= tol + :tol : |value-expect| <= tol + :units : name of the units for value, expected_value and tol :first_err : record an error message :first_warn : record a warning message Queries -list-runs patt : list runs matching pattern \"patt\", % is the wildcard @@ -109,10 +110,11 @@ ":first_err" ":first_warn" ":value" ":expected_value" ":tol" + ":units" ;; misc "-debug" ;; for *verbosity* > 2 ) (list "-h" "-force" @@ -648,11 +650,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")) + (list ":value" ":tol" ":expected_value" ":first_err" ":first_warn" ":units")) res))) (if (and (args:get-arg "-test-status") (or (not state) (not status))) (begin Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -118,10 +118,13 @@ (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)))