51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
(dbexists (file-exists? dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000))))
(handle-exceptions
exn
(begin
(debug:print 2 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
((condition-property-accessor 'exn 'message) exn))
(set! db (sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access
(set! dbexists #f)) ;; must force re-creation of tables, more tom-foolery
(set! db (sqlite3:open-database dbpath)))
(if *db-write-access* (sqlite3:set-busy-handler! db handler))
(if (not dbexists)
(begin
(sqlite3:execute db "PRAGMA synchronous = FULL;")
(debug:print-info 11 "Initialized test database " dbpath)
(tdb:testdb-initialize db)))
;; (sqlite3:execute db "PRAGMA synchronous = 0;")
(debug:print-info 11 "open-test-db END (sucessful)" work-area)
;; now let's test that everything is correct
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: 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;"))
|
>
|
>
|
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
(dbexists (file-exists? dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000))))
(handle-exceptions
exn
(begin
(print-call-chain (current-error-port))
(debug:print 2 "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
((condition-property-accessor 'exn 'message) exn))
(set! db (sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access
(set! dbexists #f)) ;; must force re-creation of tables, more tom-foolery
(set! db (sqlite3:open-database dbpath)))
(if *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 "Initialized test database " dbpath)
(tdb:testdb-initialize db)))
;; (sqlite3:execute db "PRAGMA synchronous = 0;")
(debug:print-info 11 "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 0 "ERROR: 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;"))
|
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
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 "db:testdb-initialize START")
(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 "db:testdb-initialize END"))
(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)))
|
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
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 "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 "db:testdb-initialize END"))
(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)))
|