source: project/release/4/sqlite3/trunk/tests/run.scm @ 15423

Last change on this file since 15423 was 15423, checked in by Thomas Chust, 10 years ago

[sqlite3] Modernization of C API use, support for automatic statement finalization.

File size: 9.4 KB
Line 
1;;;; test.scm
2;;;; :tabSize=2:indentSize=2:noTabs=true:
3;;;; Tests for the SQLite3 bindings
4
5(use srfi-1 srfi-13 srfi-69 test sql-null sqlite3)
6
7;;; Some utilities
8
9(define-syntax with-database
10  (syntax-rules ()
11    [(with-database [db path . finalize-statements?]
12        body ...)
13      (let ([db #f])
14        (dynamic-wind
15          (lambda ()
16            (set! db (open-database path)))
17          (lambda ()
18            body ...)
19          (lambda ()
20            (and-let* ([d db])
21              (set! db #f)
22              (finalize! d . finalize-statements?)))))]))
23
24(define-syntax with-database+statement
25  (syntax-rules ()
26    [(with-database+statement ([db path] [stmt sql])
27        body ...)
28      (with-database [db path]
29        (call-with-temporary-statements
30          (lambda (stmt)
31            body ...)
32          db sql))]))
33
34(enable-shared-cache! #t)
35
36;;; The tests
37
38(test-group "SQLite3 bindings"
39
40  (test-assert "library version"
41    (string-prefix? "3." (database-version)))
42
43  (test-group "SQL completeness checks"
44
45    (test-assert "complete SQL"
46      (sql-complete? "SELECT 42;"))
47
48    (test-assert "incomplete SQL"
49      (not (sql-complete? "SELECT -- just a comment")))
50
51    )
52
53  (test-group "statement management"
54
55    (test "basic lifecycle"
56      '(" -- tail" #t #f)
57      (with-database [db ":memory:"]
58        (let-values ([(stmt tail) (prepare db "SELECT 42; -- tail")])
59          (dynamic-wind
60            noop
61            (lambda ()
62              (let* ([s0 (step! stmt)]
63                     [s1 (step! stmt)])
64                (list tail s0 s1)))
65            (lambda ()
66              (and-let* ([s stmt])
67                (set! stmt #f)
68                (finalize! s)))))))
69
70    (test-assert "unfinalized statement detection"
71      (let ([db (open-database ":memory:")])
72        (condition-case
73          (begin
74            (prepare db "SELECT 23;")
75            (finalize! db #f)
76            #f)
77          [(exn sqlite3)
78            (finalize! db #t)
79            #t])))
80
81    (test-assert "automatic statement finalization"
82      (with-database [db ":memory:" #t]
83        (prepare db "SELECT 23;")
84        #t))
85
86    (test-error "SQL error detection"
87      (with-database [db ":memory:"]
88        (execute db "DISTIM A DOSH;")))
89
90    (test-assert "repair"
91      (with-database [db ":memory:"]
92        (execute db "CREATE TABLE Foo (id INTEGER PRIMARY KEY);")
93        (call-with-temporary-statements
94          (lambda (stmt)
95            (execute db "ALTER TABLE Foo ADD COLUMN blurb TEXT;")
96            (not (step! stmt)))
97          db "SELECT * FROM Foo;")))
98
99    (test "column count"
100      3
101      (with-database+statement ([db ":memory:"]
102                                [stmt "SELECT 1, 2, 3;"])
103        (column-count stmt)))
104
105    (test "column name"
106      '("foo" "bar")
107      (with-database [db ":memory:"]
108        (execute db "CREATE TABLE Foo(foo);")
109        (call-with-temporary-statements
110          (lambda (stmt)
111            (list
112              (column-name stmt 0)
113              (column-name stmt 1)))
114          db "SELECT foo, 42 AS bar FROM Foo;")))
115
116    (test "column declared type"
117      '("INTEGER" "TEXT")
118      (with-database [db ":memory:"]
119        (execute db "CREATE TABLE Foo (id INTEGER PRIMARY KEY, data TEXT);")
120        (call-with-temporary-statements
121          (lambda (stmt)
122            (list
123              (column-declared-type stmt 0)
124              (column-declared-type stmt 1)))
125          db "SELECT id, data FROM Foo;")))
126
127    (test "column type"
128      '(integer text)
129      (with-database [db ":memory:"]
130        (execute db "CREATE TABLE Foo (id INTEGER PRIMARY KEY, data TEXT);")
131        (update db "INSERT INTO Foo (data) VALUES (?);" "Hallo Welt!")
132        (call-with-temporary-statements
133          (lambda (stmt)
134            (step! stmt)
135            (list
136              (column-type stmt 0)
137              (column-type stmt 1)))
138          db "SELECT id, data FROM Foo;")))
139
140    (test "parameter count"
141      3
142      (with-database+statement ([db ":memory:"]
143                                [stmt "SELECT :a, :b, :c;"])
144        (bind-parameter-count stmt)))
145
146    (test "parameter name"
147      '(":foo" #f)
148      (with-database+statement ([db ":memory:"]
149                                [stmt "SELECT ?, :foo, ?;"])
150        (list
151          (bind-parameter-name stmt 1)
152          (bind-parameter-name stmt 2))))
153
154    (test "parameter index"
155      '(1 #f)
156      (with-database+statement ([db ":memory:"]
157                                [stmt "SELECT ?, :foo, ?;"])
158        (list
159          (bind-parameter-index stmt ":foo")
160          (bind-parameter-index stmt ":bar"))))
161
162    )
163
164  (test-group "simple statement interface"
165
166    (let ([data (list 42 3.5 "hallo" (string->blob "welt"))])
167      (test "data invariance"
168        data
169        (with-database+statement ([db ":memory:"]
170                                  [stmt "SELECT ?;"])
171          (map (cut first-result stmt <>) data))))
172
173    (test "boolean invariance"
174      '(#t #f)
175      (with-database [db ":memory:"]
176        (execute db "CREATE TABLE Bool (id INTEGER PRIMARY KEY, v BOOL);")
177        (call-with-temporary-statements
178          (lambda (ins)
179            (for-each (cut execute ins <> <>) (iota 2) '(#t #f)))
180          db "INSERT INTO Bool (id, v) VALUES (?, ?);")
181        (call-with-temporary-statements
182          (lambda (get)
183            (map (cut first-result get <>) (iota 2)))
184          db "SELECT v FROM Bool WHERE id = ?;")))
185
186    (test-assert "null invariance"
187      (with-database+statement ([db ":memory:"]
188                                [stmt "SELECT ?;"])
189        (sql-null? (first-result stmt (sql-null)))))
190
191    (test "single value retrieval"
192      "value"
193      (with-database+statement ([db ":memory:"]
194                                [stmt "SELECT 'value';"])
195        (first-result stmt)))
196
197    (test "single row retrieval"
198      '(1 2 3)
199      (with-database+statement ([db ":memory:"]
200                                [stmt "SELECT 1, 2, 3;"])
201        (first-row stmt)))
202
203    (test-error "missing data detection"
204      (with-database [db ":memory:"]
205        (execute db "CREATE TABLE Foo (foo);")
206        (first-result db "SELECT * FROM Foo;")))
207
208    (test "folding rows"
209      42
210      (with-database [db ":memory:"]
211        (execute db "CREATE TABLE Foo (v);")
212        (call-with-temporary-statements
213          (lambda (ins)
214            (for-each (cut execute ins <>) '(23 19)))
215          db "INSERT INTO Foo (v) VALUES (?);")
216        (fold-row + 0 db "SELECT v FROM Foo;")))
217
218    (test "mapping rows"
219      '(2 4 6)
220      (with-database [db ":memory:"]
221        (execute db "CREATE TABLE Foo (v);")
222        (call-with-temporary-statements
223          (lambda (ins)
224            (for-each (cut execute ins <>) '(1 2 3)))
225          db "INSERT INTO Foo (v) VALUES (?);")
226        (map-row (cut * 2 <>) db "SELECT v FROM Foo ORDER BY v ASC;")))
227
228    (test "iterating over rows"
229      '(#t #t #f #f)
230      (let ([tab (make-hash-table)])
231        (with-database [db ":memory:"]
232          (execute db "CREATE TABLE Foo (v);")
233          (call-with-temporary-statements
234            (lambda (ins)
235              (for-each (cut execute ins <>) '(1 2 3)))
236            db "INSERT INTO Foo (v) VALUES (?);")
237          (for-each-row (cut hash-table-set! tab <> #t) db "SELECT v FROM Foo;"))
238        (map (cut hash-table-ref tab <> (lambda () #f)) '(1 2 5 7))))
239
240    (test "change counting"
241      '(0 1 1 2)
242      (with-database [db ":memory:"]
243        (let* ([c0 (update db "CREATE TABLE Foo (foo);")]
244               [c1 (update db "INSERT INTO Foo (foo) VALUES (?);" 42)]
245               [c2 (update db "UPDATE Foo SET foo = 2 * foo WHERE foo > ?;" 23)]
246               [c3 (change-count db #t)])
247          (list c0 c1 c2 c3))))
248
249    (test "named parameters"
250      42
251      (with-database [db ":memory:"]
252        (first-result db "SELECT ? * (:foo + :bar);" bar: 9 foo: 12 2)))
253
254    (test-error "bad named parameter detection"
255      (with-database [db ":memory:"]
256        (first-result db "SELECT ? * (:foo + :bar);" 5 foo: 10 baz: 32)))
257
258    (test-error "bad parameter count detection"
259      (with-database [db ":memory:"]
260        (first-result db "SELECT ? * (:foo + :bar);" foo: 10 bar: 12)))
261
262    )
263
264  (test-group "user defined functions"
265
266    (test "collation sequences"
267      '("bar" "foo" "qux")
268      (with-database [db ":memory:"]
269        (define-collation db "second_char"
270          (lambda (a b)
271            (-
272              (char->integer (string-ref a 1))
273              (char->integer (string-ref b 1)))))
274
275        (execute db "CREATE TABLE Foo (v);")
276        (call-with-temporary-statements
277          (lambda (ins)
278            (map (cut execute ins <>) '("foo" "qux" "bar")))
279          db "INSERT INTO Foo (v) VALUES (?);")
280
281        (map-row values db "SELECT v FROM Foo ORDER BY v COLLATE second_char;")))
282
283    (test "simple functions"
284      "It works!"
285      (with-database [db ":memory:"]
286        (define-function db "foo" 1
287          (cut string-append "It " <> "!"))
288        (first-result db "SELECT foo(?);" "works")))
289
290    (test "aggregate functions"
291      262144
292      (with-database [db ":memory:"]
293        (define-function db "expt" 1
294          (lambda (s v) (expt v s)) 1)
295
296        (execute db "CREATE TABLE Foo (v);")
297        (call-with-temporary-statements
298          (lambda (ins)
299            (for-each (cut execute ins <>) (iota 5)))
300          db "INSERT INTO Foo (v) VALUES (?);")
301
302        (first-result db "SELECT expt(v) FROM Foo;")))
303
304    )
305
306  )
307
308(print "Database memory still used: " (database-memory-used))
309(print "Database memory high water mark: " (database-memory-highwater))
Note: See TracBrowser for help on using the repository browser.