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

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

sqlite3: Merged bindings of database memory statistics functions.

File size: 8.9 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]
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)))))]))
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-error "SQL error detection"
71      (with-database [db ":memory:"]
72        (execute db "DISTIM A DOSH;")))
73
74    (test-assert "repair"
75      (with-database [db ":memory:"]
76        (execute db "CREATE TABLE Foo (id INTEGER PRIMARY KEY);")
77        (call-with-temporary-statements
78          (lambda (stmt)
79            (execute db "ALTER TABLE Foo ADD COLUMN blurb TEXT;")
80            (not (step! stmt)))
81          db "SELECT * FROM Foo;")))
82
83    (test "column count"
84      3
85      (with-database+statement ([db ":memory:"]
86                                [stmt "SELECT 1, 2, 3;"])
87        (column-count stmt)))
88
89    (test "column name"
90      '("foo" "bar")
91      (with-database [db ":memory:"]
92        (execute db "CREATE TABLE Foo(foo);")
93        (call-with-temporary-statements
94          (lambda (stmt)
95            (list
96              (column-name stmt 0)
97              (column-name stmt 1)))
98          db "SELECT foo, 42 AS bar FROM Foo;")))
99
100    (test "column declared type"
101      '("INTEGER" "TEXT")
102      (with-database [db ":memory:"]
103        (execute db "CREATE TABLE Foo (id INTEGER PRIMARY KEY, data TEXT);")
104        (call-with-temporary-statements
105          (lambda (stmt)
106            (list
107              (column-declared-type stmt 0)
108              (column-declared-type stmt 1)))
109          db "SELECT id, data FROM Foo;")))
110
111    (test "column type"
112      '(integer text)
113      (with-database [db ":memory:"]
114        (execute db "CREATE TABLE Foo (id INTEGER PRIMARY KEY, data TEXT);")
115        (update db "INSERT INTO Foo (data) VALUES (?);" "Hallo Welt!")
116        (call-with-temporary-statements
117          (lambda (stmt)
118            (step! stmt)
119            (list
120              (column-type stmt 0)
121              (column-type stmt 1)))
122          db "SELECT id, data FROM Foo;")))
123
124    (test "parameter count"
125      3
126      (with-database+statement ([db ":memory:"]
127                                [stmt "SELECT :a, :b, :c;"])
128        (bind-parameter-count stmt)))
129
130    (test "parameter name"
131      '(":foo" #f)
132      (with-database+statement ([db ":memory:"]
133                                [stmt "SELECT ?, :foo, ?;"])
134        (list
135          (bind-parameter-name stmt 1)
136          (bind-parameter-name stmt 2))))
137
138    (test "parameter index"
139      '(1 #f)
140      (with-database+statement ([db ":memory:"]
141                                [stmt "SELECT ?, :foo, ?;"])
142        (list
143          (bind-parameter-index stmt ":foo")
144          (bind-parameter-index stmt ":bar"))))
145
146    )
147
148  (test-group "simple statement interface"
149
150    (let ([data (list 42 3.5 "hallo" (string->blob "welt"))])
151      (test "data invariance"
152        data
153        (with-database+statement ([db ":memory:"]
154                                  [stmt "SELECT ?;"])
155          (map (cut first-result stmt <>) data))))
156
157    (test "boolean invariance"
158      '(#t #f)
159      (with-database [db ":memory:"]
160        (execute db "CREATE TABLE Bool (id INTEGER PRIMARY KEY, v BOOL);")
161        (call-with-temporary-statements
162          (lambda (ins)
163            (for-each (cut execute ins <> <>) (iota 2) '(#t #f)))
164          db "INSERT INTO Bool (id, v) VALUES (?, ?);")
165        (call-with-temporary-statements
166          (lambda (get)
167            (map (cut first-result get <>) (iota 2)))
168          db "SELECT v FROM Bool WHERE id = ?;")))
169
170    (test-assert "null invariance"
171      (with-database+statement ([db ":memory:"]
172                                [stmt "SELECT ?;"])
173        (sql-null? (first-result stmt (sql-null)))))
174
175    (test "single value retrieval"
176      "value"
177      (with-database+statement ([db ":memory:"]
178                                [stmt "SELECT 'value';"])
179        (first-result stmt)))
180
181    (test "single row retrieval"
182      '(1 2 3)
183      (with-database+statement ([db ":memory:"]
184                                [stmt "SELECT 1, 2, 3;"])
185        (first-row stmt)))
186
187    (test-error "missing data detection"
188      (with-database [db ":memory:"]
189        (execute db "CREATE TABLE Foo (foo);")
190        (first-result db "SELECT * FROM Foo;")))
191
192    (test "folding rows"
193      42
194      (with-database [db ":memory:"]
195        (execute db "CREATE TABLE Foo (v);")
196        (call-with-temporary-statements
197          (lambda (ins)
198            (for-each (cut execute ins <>) '(23 19)))
199          db "INSERT INTO Foo (v) VALUES (?);")
200        (fold-row + 0 db "SELECT v FROM Foo;")))
201
202    (test "mapping rows"
203      '(2 4 6)
204      (with-database [db ":memory:"]
205        (execute db "CREATE TABLE Foo (v);")
206        (call-with-temporary-statements
207          (lambda (ins)
208            (for-each (cut execute ins <>) '(1 2 3)))
209          db "INSERT INTO Foo (v) VALUES (?);")
210        (map-row (cut * 2 <>) db "SELECT v FROM Foo ORDER BY v ASC;")))
211
212    (test "iterating over rows"
213      '(#t #t #f #f)
214      (let ([tab (make-hash-table)])
215        (with-database [db ":memory:"]
216          (execute db "CREATE TABLE Foo (v);")
217          (call-with-temporary-statements
218            (lambda (ins)
219              (for-each (cut execute ins <>) '(1 2 3)))
220            db "INSERT INTO Foo (v) VALUES (?);")
221          (for-each-row (cut hash-table-set! tab <> #t) db "SELECT v FROM Foo;"))
222        (map (cut hash-table-ref tab <> (lambda () #f)) '(1 2 5 7))))
223
224    (test "change counting"
225      '(0 1 1 2)
226      (with-database [db ":memory:"]
227        (let* ([c0 (update db "CREATE TABLE Foo (foo);")]
228               [c1 (update db "INSERT INTO Foo (foo) VALUES (?);" 42)]
229               [c2 (update db "UPDATE Foo SET foo = 2 * foo WHERE foo > ?;" 23)]
230               [c3 (change-count db #t)])
231          (list c0 c1 c2 c3))))
232
233    (test "named parameters"
234      42
235      (with-database [db ":memory:"]
236        (first-result db "SELECT ? * (:foo + :bar);" bar: 9 foo: 12 2)))
237
238    (test-error "bad named parameter detection"
239      (with-database [db ":memory:"]
240        (first-result db "SELECT ? * (:foo + :bar);" 5 foo: 10 baz: 32)))
241
242    (test-error "bad parameter count detection"
243      (with-database [db ":memory:"]
244        (first-result db "SELECT ? * (:foo + :bar);" foo: 10 bar: 12)))
245
246    )
247
248  (test-group "user defined functions"
249
250    (test "collation sequences"
251      '("bar" "foo" "qux")
252      (with-database [db ":memory:"]
253        (define-collation db "second_char"
254          (lambda (a b)
255            (-
256              (char->integer (string-ref a 1))
257              (char->integer (string-ref b 1)))))
258
259        (execute db "CREATE TABLE Foo (v);")
260        (call-with-temporary-statements
261          (lambda (ins)
262            (map (cut execute ins <>) '("foo" "qux" "bar")))
263          db "INSERT INTO Foo (v) VALUES (?);")
264
265        (map-row values db "SELECT v FROM Foo ORDER BY v COLLATE second_char;")))
266
267    (test "simple functions"
268      "It works!"
269      (with-database [db ":memory:"]
270        (define-function db "foo" 1
271          (cut string-append "It " <> "!"))
272        (first-result db "SELECT foo(?);" "works")))
273
274    (test "aggregate functions"
275      262144
276      (with-database [db ":memory:"]
277        (define-function db "expt" 1
278          (lambda (s v) (expt v s)) 1)
279
280        (execute db "CREATE TABLE Foo (v);")
281        (call-with-temporary-statements
282          (lambda (ins)
283            (for-each (cut execute ins <>) (iota 5)))
284          db "INSERT INTO Foo (v) VALUES (?);")
285
286        (first-result db "SELECT expt(v) FROM Foo;")))
287
288    )
289
290  )
291
292(print "Database memory still used: " (database-memory-used))
293(print "Database memory high water mark: " (database-memory-highwater))
Note: See TracBrowser for help on using the repository browser.