source: project/release/5/sqlite3/trunk/tests/run.scm @ 36618

Last change on this file since 36618 was 36618, checked in by Thomas Chust, 11 months ago

[sqlite3] Ported CHICKEN 4 code to CHICKEN 5, thanks to Vasilij for patches

File size: 11.0 KB
Line 
1;; This file is part of SQLite3 for CHICKEN
2;; Copyright (c) 2005-2018, Thomas Chust <chust@web.de>.  All rights reserved.
3;;
4;; Redistribution and use in source and binary forms, with or without
5;; modification, are permitted provided that the following conditions are met:
6;;
7;;   Redistributions of source code must retain the above copyright notice,
8;;   this list of conditions and the following disclaimer. Redistributions in
9;;   binary form must reproduce the above copyright notice, this list of
10;;   conditions and the following disclaimer in the documentation and/or
11;;   other materials provided with the distribution. Neither the name of the
12;;   author nor the names of its contributors may be used to endorse or
13;;   promote products derived from this software without specific prior
14;;   written permission.
15;;
16;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
17;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
18;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
19;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
20;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
21;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
22;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
23;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
24;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
25;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
26;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27
28(import
29  scheme
30  (chicken blob)
31  (srfi 1)
32  (srfi 13)
33  (srfi 69)
34  test
35  sql-null
36  sqlite3)
37
38;;; Some utilities
39
40(define-syntax with-database
41  (syntax-rules ()
42    [(with-database [db path . finalize-statements?]
43        body ...)
44      (let ([db #f])
45        (dynamic-wind
46          (lambda ()
47            (set! db (open-database path)))
48          (lambda ()
49            body ...)
50          (lambda ()
51            (and-let* ([d db])
52              (set! db #f)
53              (finalize! d . finalize-statements?)))))]))
54
55(define-syntax with-database+statement
56  (syntax-rules ()
57    [(with-database+statement ([db path] [stmt sql])
58        body ...)
59      (with-database [db path]
60        (call-with-temporary-statements
61          (lambda (stmt)
62            body ...)
63          db sql))]))
64
65(enable-shared-cache! #t)
66
67;;; The tests
68
69(test-group "SQLite3 bindings"
70
71  (test-assert "library version"
72    (string-prefix? "3." (database-version)))
73
74  (test-group "SQL completeness checks"
75
76    (test-assert "complete SQL"
77      (sql-complete? "SELECT 42;"))
78
79    (test-assert "incomplete SQL"
80      (not (sql-complete? "SELECT -- just a comment")))
81
82    )
83
84  (test-group "statement management"
85
86    (test "basic lifecycle"
87      '(" -- tail" #t #f)
88      (with-database [db ":memory:"]
89        (let-values ([(stmt tail) (prepare db "SELECT 42; -- tail")])
90          (dynamic-wind
91            void
92            (lambda ()
93              (let* ([s0 (step! stmt)]
94                     [s1 (step! stmt)])
95                (list tail s0 s1)))
96            (lambda ()
97              (and-let* ([s stmt])
98                (set! stmt #f)
99                (finalize! s)))))))
100
101    (test-assert "unfinalized statement detection"
102      (let ([db (open-database ":memory:")])
103        (condition-case
104          (begin
105            (prepare db "SELECT 23;")
106            (finalize! db #f)
107            #f)
108          [(exn sqlite3)
109            (finalize! db #t)
110            #t])))
111
112    (test-assert "automatic statement finalization"
113      (with-database [db ":memory:" #t]
114        (prepare db "SELECT 23;")
115        #t))
116
117    (test-error "SQL error detection"
118      (with-database [db ":memory:"]
119        (execute db "DISTIM A DOSH;")))
120
121    (test-assert "repair"
122      (with-database [db ":memory:"]
123        (execute db "CREATE TABLE Foo (id INTEGER PRIMARY KEY);")
124        (call-with-temporary-statements
125          (lambda (stmt)
126            (execute db "ALTER TABLE Foo ADD COLUMN blurb TEXT;")
127            (not (step! stmt)))
128          db "SELECT * FROM Foo;")))
129
130    (test "column count"
131      3
132      (with-database+statement ([db ":memory:"]
133                                [stmt "SELECT 1, 2, 3;"])
134        (column-count stmt)))
135
136    (test "column name"
137      '("foo" "bar")
138      (with-database [db ":memory:"]
139        (execute db "CREATE TABLE Foo(foo);")
140        (call-with-temporary-statements
141          (lambda (stmt)
142            (list
143              (column-name stmt 0)
144              (column-name stmt 1)))
145          db "SELECT foo, 42 AS bar FROM Foo;")))
146
147    (test "column declared type"
148      '("INTEGER" "TEXT")
149      (with-database [db ":memory:"]
150        (execute db "CREATE TABLE Foo (id INTEGER PRIMARY KEY, data TEXT);")
151        (call-with-temporary-statements
152          (lambda (stmt)
153            (list
154              (column-declared-type stmt 0)
155              (column-declared-type stmt 1)))
156          db "SELECT id, data FROM Foo;")))
157
158    (test "column type"
159      '(integer text)
160      (with-database [db ":memory:"]
161        (execute db "CREATE TABLE Foo (id INTEGER PRIMARY KEY, data TEXT);")
162        (update db "INSERT INTO Foo (data) VALUES (?);" "Hallo Welt!")
163        (call-with-temporary-statements
164          (lambda (stmt)
165            (step! stmt)
166            (list
167              (column-type stmt 0)
168              (column-type stmt 1)))
169          db "SELECT id, data FROM Foo;")))
170
171    (test "parameter count"
172      3
173      (with-database+statement ([db ":memory:"]
174                                [stmt "SELECT :a, :b, :c;"])
175        (bind-parameter-count stmt)))
176
177    (test "parameter name"
178      '(":foo" #f)
179      (with-database+statement ([db ":memory:"]
180                                [stmt "SELECT ?, :foo, ?;"])
181        (list
182          (bind-parameter-name stmt 1)
183          (bind-parameter-name stmt 2))))
184
185    (test "parameter index"
186      '(1 #f)
187      (with-database+statement ([db ":memory:"]
188                                [stmt "SELECT ?, :foo, ?;"])
189        (list
190          (bind-parameter-index stmt ":foo")
191          (bind-parameter-index stmt ":bar"))))
192
193    )
194
195  (test-group "simple statement interface"
196
197    (let ([data (list 42 3.5 "hallo" (string->blob "welt"))])
198      (test "data invariance"
199        data
200        (with-database+statement ([db ":memory:"]
201                                  [stmt "SELECT ?;"])
202          (map (cut first-result stmt <>) data))))
203
204    (test "boolean invariance"
205      '(#t #f)
206      (with-database [db ":memory:"]
207        (execute db "CREATE TABLE Bool (id INTEGER PRIMARY KEY, v BOOL);")
208        (call-with-temporary-statements
209          (lambda (ins)
210            (for-each (cut execute ins <> <>) (iota 2) '(#t #f)))
211          db "INSERT INTO Bool (id, v) VALUES (?, ?);")
212        (call-with-temporary-statements
213          (lambda (get)
214            (map (cut first-result get <>) (iota 2)))
215          db "SELECT v FROM Bool WHERE id = ?;")))
216
217    (test-assert "null invariance"
218      (with-database+statement ([db ":memory:"]
219                                [stmt "SELECT ?;"])
220        (sql-null? (first-result stmt (sql-null)))))
221
222    (test "single value retrieval"
223      "value"
224      (with-database+statement ([db ":memory:"]
225                                [stmt "SELECT 'value';"])
226        (first-result stmt)))
227
228    (test "single row retrieval"
229      '(1 2 3)
230      (with-database+statement ([db ":memory:"]
231                                [stmt "SELECT 1, 2, 3;"])
232        (first-row stmt)))
233
234    (test-error "missing data detection"
235      (with-database [db ":memory:"]
236        (execute db "CREATE TABLE Foo (foo);")
237        (first-result db "SELECT * FROM Foo;")))
238
239    (test "folding rows"
240      42
241      (with-database [db ":memory:"]
242        (execute db "CREATE TABLE Foo (v);")
243        (call-with-temporary-statements
244          (lambda (ins)
245            (for-each (cut execute ins <>) '(23 19)))
246          db "INSERT INTO Foo (v) VALUES (?);")
247        (fold-row + 0 db "SELECT v FROM Foo;")))
248
249    (test "mapping rows"
250      '(2 4 6)
251      (with-database [db ":memory:"]
252        (execute db "CREATE TABLE Foo (v);")
253        (call-with-temporary-statements
254          (lambda (ins)
255            (for-each (cut execute ins <>) '(1 2 3)))
256          db "INSERT INTO Foo (v) VALUES (?);")
257        (map-row (cut * 2 <>) db "SELECT v FROM Foo ORDER BY v ASC;")))
258
259    (test "iterating over rows"
260      '(#t #t #f #f)
261      (let ([tab (make-hash-table)])
262        (with-database [db ":memory:"]
263          (execute db "CREATE TABLE Foo (v);")
264          (call-with-temporary-statements
265            (lambda (ins)
266              (for-each (cut execute ins <>) '(1 2 3)))
267            db "INSERT INTO Foo (v) VALUES (?);")
268          (for-each-row (cut hash-table-set! tab <> #t) db "SELECT v FROM Foo;"))
269        (map (cut hash-table-ref tab <> (lambda () #f)) '(1 2 5 7))))
270
271    (test "change counting"
272      '(0 1 1 2)
273      (with-database [db ":memory:"]
274        (let* ([c0 (update db "CREATE TABLE Foo (foo);")]
275               [c1 (update db "INSERT INTO Foo (foo) VALUES (?);" 42)]
276               [c2 (update db "UPDATE Foo SET foo = 2 * foo WHERE foo > ?;" 23)]
277               [c3 (change-count db #t)])
278          (list c0 c1 c2 c3))))
279
280    (test "named parameters"
281      42
282      (with-database [db ":memory:"]
283        (first-result db "SELECT ? * (:foo + :bar);" bar: 9 foo: 12 2)))
284
285    (test-error "bad named parameter detection"
286      (with-database [db ":memory:"]
287        (first-result db "SELECT ? * (:foo + :bar);" 5 foo: 10 baz: 32)))
288
289    (test-error "bad parameter count detection"
290      (with-database [db ":memory:"]
291        (first-result db "SELECT ? * (:foo + :bar);" foo: 10 bar: 12)))
292
293    )
294
295  (test-group "user defined functions"
296
297    (test "collation sequences"
298      '("bar" "foo" "qux")
299      (with-database [db ":memory:"]
300        (define-collation db "second_char"
301          (lambda (a b)
302            (-
303              (char->integer (string-ref a 1))
304              (char->integer (string-ref b 1)))))
305
306        (execute db "CREATE TABLE Foo (v);")
307        (call-with-temporary-statements
308          (lambda (ins)
309            (map (cut execute ins <>) '("foo" "qux" "bar")))
310          db "INSERT INTO Foo (v) VALUES (?);")
311
312        (map-row values db "SELECT v FROM Foo ORDER BY v COLLATE second_char;")))
313
314    (test "simple functions"
315      "It works!"
316      (with-database [db ":memory:"]
317        (define-function db "foo" 1
318          (cut string-append "It " <> "!"))
319        (first-result db "SELECT foo(?);" "works")))
320
321    (test "aggregate functions"
322      262144
323      (with-database [db ":memory:"]
324        (define-function db "expt" 1
325          (lambda (s v) (expt v s)) 1)
326
327        (execute db "CREATE TABLE Foo (v);")
328        (call-with-temporary-statements
329          (lambda (ins)
330            (for-each (cut execute ins <>) (iota 5)))
331          db "INSERT INTO Foo (v) VALUES (?);")
332
333        (first-result db "SELECT expt(v) FROM Foo;")))
334
335    )
336
337  )
338
339(print "Database memory still used: " (database-memory-used))
340(print "Database memory high water mark: " (database-memory-highwater))
341
342(test-exit)
343
344;; vim: set ai et ts=8 sts=2 sw=2 ft=scheme: ;;
Note: See TracBrowser for help on using the repository browser.