@@ -56,155 +56,155 @@ ;;====================================================================== ;; T E S T S P E C I F I C D B ;;====================================================================== -;; Create the sqlite db for the individual test(s) -;; -;; Moved these tables into .db -;; THIS CODE TO BE REMOVED -;; -(define (open-test-db work-area) - (debug:print-info 11 *default-log-port* "open-test-db " work-area) - (if (and work-area - (directory? work-area) - (file-read-access? work-area)) - (let* ((dbpath (conc work-area "/testdat.db")) - (dbexists (common:file-exists? dbpath)) - (work-area-writeable (file-write-access? work-area)) - (db (handle-exceptions ;; open the db if area writeable or db pre-existing. open in-mem otherwise. if exception, open in-mem - exn - (begin - (print-call-chain (current-error-port)) - (debug:print 2 *default-log-port* "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test" - ((condition-property-accessor 'exn 'message) exn)) - (set! dbexists #f) ;; must force re-creation of tables, more tom-foolery - (sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access - (if (or work-area-writeable - dbexists) - (sqlite3:open-database dbpath) - (sqlite3:open-database ":memory:")))) - (tdb-writeable (and (file-write-access? work-area) - (file-write-access? dbpath))) - (handler (sqlite3:make-busy-timeout (if (args:get-arg "-override-timeout") - (string->number (args:get-arg "-override-timeout")) - 136000)))) - - (if (and tdb-writeable - *db-write-access*) - (sqlite3:set-busy-handler! db handler)) - (if (not dbexists) - (begin - (db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = FULL;") - (debug:print-info 11 *default-log-port* "Initialized test database " dbpath) - (tdb:testdb-initialize db))) - ;; (sqlite3:execute db "PRAGMA synchronous = 0;") - (debug:print-info 11 *default-log-port* "open-test-db END (sucessful)" work-area) - ;; now let's test that everything is correct - (handle-exceptions - exn - (begin - (print-call-chain (current-error-port)) - (debug:print-error 0 *default-log-port* "problem accessing test db " work-area ", you probably should clean and re-run this test or remove the file " - dbpath ".\n " - ((condition-property-accessor 'exn 'message) exn)) - #f) - ;; Is there a cheaper single line operation that will check for existance of a table - ;; and raise an exception ? - (sqlite3:execute db "SELECT id FROM test_data LIMIT 1;")) - db) - ;; no work-area or not readable - create a placeholder to fake rest of world out - (let ((baddb (sqlite3:open-database ":memory:"))) - (debug:print-info 11 *default-log-port* "open-test-db END (unsucessful)" work-area) - ;; provide an in-mem db (this is dangerous!) - (tdb:testdb-initialize baddb) - baddb))) - -;; find and open the testdat.db file for an existing test -(define (tdb:open-test-db-by-test-id test-id #!key (work-area #f)) - (let* ((test-path (if work-area - work-area - (rmt:test-get-rundir-from-test-id test-id)))) - (debug:print 3 *default-log-port* "TEST PATH: " test-path) - (open-test-db test-path))) - -;; find and open the testdat.db file for an existing test -(define (tdb:open-test-db-by-test-id-local dbstruct run-id test-id #!key (work-area #f)) - (let* ((test-path (if work-area - work-area - (db:test-get-rundir-from-test-id dbstruct run-id test-id)))) - (debug:print 3 *default-log-port* "TEST PATH: " test-path) - (open-test-db test-path))) - -;; find and open the testdat.db file for an existing test -(define (tdb:open-run-close-db-by-test-id-local dbstruct run-id test-id work-area proc . params) - (let* ((test-path (if work-area - work-area - (db:test-get-rundir-from-test-id dbstruct run-id test-id))) - (tdb (open-test-db test-path))) - (apply proc tdb params))) - -(define (tdb:testdb-initialize db) - (debug:print 11 *default-log-port* "db:testdb-initialize START") - (sqlite3:with-transaction - db - (lambda () - (for-each - (lambda (sqlcmd) - (sqlite3:execute db sqlcmd)) - (list "CREATE TABLE IF NOT EXISTS test_rundat ( - id INTEGER PRIMARY KEY, - update_time TIMESTAMP, - cpuload INTEGER DEFAULT -1, - diskfree INTEGER DEFAULT -1, - diskusage INTGER DEFAULT -1, - run_duration INTEGER DEFAULT 0);" - "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', - type TEXT DEFAULT '', - CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));" - "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, - comment TEXT DEFAULT '', - logfile TEXT DEFAULT '', - CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));" - ;; test_meta can be used for handing commands to the test - ;; e.g. KILLREQ - ;; the ackstate is set to 1 once the command has been completed - "CREATE TABLE IF NOT EXISTS test_meta ( - id INTEGER PRIMARY KEY, - var TEXT, - val TEXT, - ackstate INTEGER DEFAULT 0, - CONSTRAINT metadat_constraint UNIQUE (var));")))) - (debug:print 11 *default-log-port* "db:testdb-initialize END")) - -;; This routine moved to db:read-test-data -;; -(define (tdb:read-test-data tdb test-id categorypatt) - (let ((res '())) - (sqlite3:for-each-row - (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))) - tdb - "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) - (sqlite3:finalize! tdb) - (reverse res))) +;; =not-used= ;; Create the sqlite db for the individual test(s) +;; =not-used= ;; +;; =not-used= ;; Moved these tables into .db +;; =not-used= ;; THIS CODE TO BE REMOVED +;; =not-used= ;; +;; =not-used= (define (open-test-db work-area) +;; =not-used= (debug:print-info 11 *default-log-port* "open-test-db " work-area) +;; =not-used= (if (and work-area +;; =not-used= (directory? work-area) +;; =not-used= (file-read-access? work-area)) +;; =not-used= (let* ((dbpath (conc work-area "/testdat.db")) +;; =not-used= (dbexists (common:file-exists? dbpath)) +;; =not-used= (work-area-writeable (file-write-access? work-area)) +;; =not-used= (db (handle-exceptions ;; open the db if area writeable or db pre-existing. open in-mem otherwise. if exception, open in-mem +;; =not-used= exn +;; =not-used= (begin +;; =not-used= (print-call-chain (current-error-port)) +;; =not-used= (debug:print 2 *default-log-port* "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test" +;; =not-used= ((condition-property-accessor 'exn 'message) exn)) +;; =not-used= (set! dbexists #f) ;; must force re-creation of tables, more tom-foolery +;; =not-used= (sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access +;; =not-used= (if (or work-area-writeable +;; =not-used= dbexists) +;; =not-used= (sqlite3:open-database dbpath) +;; =not-used= (sqlite3:open-database ":memory:")))) +;; =not-used= (tdb-writeable (and (file-write-access? work-area) +;; =not-used= (file-write-access? dbpath))) +;; =not-used= (handler (sqlite3:make-busy-timeout (if (args:get-arg "-override-timeout") +;; =not-used= (string->number (args:get-arg "-override-timeout")) +;; =not-used= 136000)))) +;; =not-used= +;; =not-used= (if (and tdb-writeable +;; =not-used= *db-write-access*) +;; =not-used= (sqlite3:set-busy-handler! db handler)) +;; =not-used= (if (not dbexists) +;; =not-used= (begin +;; =not-used= (db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = FULL;") +;; =not-used= (debug:print-info 11 *default-log-port* "Initialized test database " dbpath) +;; =not-used= (tdb:testdb-initialize db))) +;; =not-used= ;; (sqlite3:execute db "PRAGMA synchronous = 0;") +;; =not-used= (debug:print-info 11 *default-log-port* "open-test-db END (sucessful)" work-area) +;; =not-used= ;; now let's test that everything is correct +;; =not-used= (handle-exceptions +;; =not-used= exn +;; =not-used= (begin +;; =not-used= (print-call-chain (current-error-port)) +;; =not-used= (debug:print-error 0 *default-log-port* "problem accessing test db " work-area ", you probably should clean and re-run this test or remove the file " +;; =not-used= dbpath ".\n " +;; =not-used= ((condition-property-accessor 'exn 'message) exn)) +;; =not-used= #f) +;; =not-used= ;; Is there a cheaper single line operation that will check for existance of a table +;; =not-used= ;; and raise an exception ? +;; =not-used= (sqlite3:execute db "SELECT id FROM test_data LIMIT 1;")) +;; =not-used= db) +;; =not-used= ;; no work-area or not readable - create a placeholder to fake rest of world out +;; =not-used= (let ((baddb (sqlite3:open-database ":memory:"))) +;; =not-used= (debug:print-info 11 *default-log-port* "open-test-db END (unsucessful)" work-area) +;; =not-used= ;; provide an in-mem db (this is dangerous!) +;; =not-used= (tdb:testdb-initialize baddb) +;; =not-used= baddb))) +;; =not-used= +;; =not-used= ;; find and open the testdat.db file for an existing test +;; =not-used= (define (tdb:open-test-db-by-test-id test-id #!key (work-area #f)) +;; =not-used= (let* ((test-path (if work-area +;; =not-used= work-area +;; =not-used= (rmt:test-get-rundir-from-test-id test-id)))) +;; =not-used= (debug:print 3 *default-log-port* "TEST PATH: " test-path) +;; =not-used= (open-test-db test-path))) +;; =not-used= +;; =not-used= ;; find and open the testdat.db file for an existing test +;; =not-used= (define (tdb:open-test-db-by-test-id-local dbstruct run-id test-id #!key (work-area #f)) +;; =not-used= (let* ((test-path (if work-area +;; =not-used= work-area +;; =not-used= (db:test-get-rundir-from-test-id dbstruct run-id test-id)))) +;; =not-used= (debug:print 3 *default-log-port* "TEST PATH: " test-path) +;; =not-used= (open-test-db test-path))) +;; =not-used= +;; =not-used= ;; find and open the testdat.db file for an existing test +;; =not-used= (define (tdb:open-run-close-db-by-test-id-local dbstruct run-id test-id work-area proc . params) +;; =not-used= (let* ((test-path (if work-area +;; =not-used= work-area +;; =not-used= (db:test-get-rundir-from-test-id dbstruct run-id test-id))) +;; =not-used= (tdb (open-test-db test-path))) +;; =not-used= (apply proc tdb params))) +;; =not-used= +;; =not-used= (define (tdb:testdb-initialize db) +;; =not-used= (debug:print 11 *default-log-port* "db:testdb-initialize START") +;; =not-used= (sqlite3:with-transaction +;; =not-used= db +;; =not-used= (lambda () +;; =not-used= (for-each +;; =not-used= (lambda (sqlcmd) +;; =not-used= (sqlite3:execute db sqlcmd)) +;; =not-used= (list "CREATE TABLE IF NOT EXISTS test_rundat ( +;; =not-used= id INTEGER PRIMARY KEY, +;; =not-used= update_time TIMESTAMP, +;; =not-used= cpuload INTEGER DEFAULT -1, +;; =not-used= diskfree INTEGER DEFAULT -1, +;; =not-used= diskusage INTGER DEFAULT -1, +;; =not-used= run_duration INTEGER DEFAULT 0);" +;; =not-used= "CREATE TABLE IF NOT EXISTS test_data ( +;; =not-used= id INTEGER PRIMARY KEY, +;; =not-used= test_id INTEGER, +;; =not-used= category TEXT DEFAULT '', +;; =not-used= variable TEXT, +;; =not-used= value REAL, +;; =not-used= expected REAL, +;; =not-used= tol REAL, +;; =not-used= units TEXT, +;; =not-used= comment TEXT DEFAULT '', +;; =not-used= status TEXT DEFAULT 'n/a', +;; =not-used= type TEXT DEFAULT '', +;; =not-used= CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));" +;; =not-used= "CREATE TABLE IF NOT EXISTS test_steps ( +;; =not-used= id INTEGER PRIMARY KEY, +;; =not-used= test_id INTEGER, +;; =not-used= stepname TEXT, +;; =not-used= state TEXT DEFAULT 'NOT_STARTED', +;; =not-used= status TEXT DEFAULT 'n/a', +;; =not-used= event_time TIMESTAMP, +;; =not-used= comment TEXT DEFAULT '', +;; =not-used= logfile TEXT DEFAULT '', +;; =not-used= CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));" +;; =not-used= ;; test_meta can be used for handing commands to the test +;; =not-used= ;; e.g. KILLREQ +;; =not-used= ;; the ackstate is set to 1 once the command has been completed +;; =not-used= "CREATE TABLE IF NOT EXISTS test_meta ( +;; =not-used= id INTEGER PRIMARY KEY, +;; =not-used= var TEXT, +;; =not-used= val TEXT, +;; =not-used= ackstate INTEGER DEFAULT 0, +;; =not-used= CONSTRAINT metadat_constraint UNIQUE (var));")))) +;; =not-used= (debug:print 11 *default-log-port* "db:testdb-initialize END")) +;; =not-used= +;; =not-used= ;; This routine moved to db:read-test-data +;; =not-used= ;; +;; =not-used= (define (tdb:read-test-data tdb test-id categorypatt) +;; =not-used= (let ((res '())) +;; =not-used= (sqlite3:for-each-row +;; =not-used= (lambda (id test_id category variable value expected tol units comment status type) +;; =not-used= (set! res (cons (vector id test_id category variable value expected tol units comment status type) res))) +;; =not-used= tdb +;; =not-used= "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) +;; =not-used= (sqlite3:finalize! tdb) +;; =not-used= (reverse res))) ;;====================================================================== ;; T E S T D A T A ;;====================================================================== @@ -248,14 +248,10 @@ (loop (read-line))))) ;; roll up the current results. ;; FIXME: Add the status too (rmt:test-data-rollup run-id test-id #f)) -(define (tdb:get-prev-tol-for-test tdb test-id category variable) - ;; Finish me? - (values #f #f #f)) - ;;====================================================================== ;; S T E P S ;;====================================================================== (define (tdb:step-get-time-as-string vec)