1 (defpackage :sqlite-tests
2 (:use
:cl
:sqlite
:5am
:iter
:bordeaux-threads
)
3 (:export
:run-all-sqlite-tests
))
5 (in-package :sqlite-tests
)
7 (def-suite sqlite-suite
)
9 (defun run-all-sqlite-tests ()
12 (in-suite sqlite-suite
)
15 (with-open-database (db ":memory:")))
17 (test test-disconnect-with-statements
19 (with-open-database (db ":memory:")
20 (prepare-statement db
"create table users (id integer primary key, user_name text not null, age integer null)"))))
22 (defmacro with-inserted-data
((db) &body body
)
23 `(with-open-database (,db
":memory:")
24 (execute-non-query ,db
"create table users (id integer primary key, user_name text not null, age integer null)")
25 (execute-non-query ,db
"insert into users (user_name, age) values (?, ?)" "joe" 18)
26 (execute-non-query ,db
"insert into users (user_name, age) values (?, ?)" "dvk" 22)
27 (execute-non-query ,db
"insert into users (user_name, age) values (?, ?)" "qwe" 30)
30 (test create-table-insert-and-error
31 (with-inserted-data (db)
32 (signals sqlite-constraint-error
33 (execute-non-query db
"insert into users (user_name, age) values (?, ?)" nil nil
))))
35 (test create-table-insert-and-error
/named
36 (with-inserted-data (db)
37 (signals sqlite-constraint-error
38 (execute-non-query/named db
"insert into users (user_name, age) values (:name, :age)" ":name" nil
":age" nil
))))
40 (test test-select-single
41 (with-inserted-data (db)
42 (is (= (execute-single db
"select id from users where user_name = ?" "dvk")
45 (test test-select-single
/named
46 (with-inserted-data (db)
47 (is (= (execute-single/named db
"select id from users where user_name = :name" ":name" "dvk")
51 (with-inserted-data (db)
52 (is (equalp (multiple-value-list (execute-one-row-m-v db
"select id, user_name, age from users where user_name = ?" "joe"))
55 (test test-select-m-v
/named
56 (with-inserted-data (db)
57 (is (equalp (multiple-value-list (execute-one-row-m-v/named db
"select id, user_name, age from users where user_name = :name" ":name" "joe"))
60 (test test-select-list
61 (with-inserted-data (db)
62 (is (equalp (execute-to-list db
"select id, user_name, age from users")
63 '((1 "joe" 18) (2 "dvk" 22) (3 "qwe" 30))))))
66 (with-inserted-data (db)
67 (is (equalp (iter (for (id user-name age
) in-sqlite-query
"select id, user_name, age from users where age < ?" on-database db with-parameters
(25))
68 (collect (list id user-name age
)))
69 '((1 "joe" 18) (2 "dvk" 22))))))
71 (test test-iterate
/named
72 (with-inserted-data (db)
73 (is (equalp (iter (for (id user-name age
) in-sqlite-query
/named
"select id, user_name, age from users where age < :age" on-database db with-parameters
(":age" 25))
74 (collect (list id user-name age
)))
75 '((1 "joe" 18) (2 "dvk" 22))))))
77 (test test-loop-with-prepared-statement
78 (with-inserted-data (db)
80 with statement
= (prepare-statement db
"select id, user_name, age from users where age < ?")
81 initially
(bind-parameter statement
1 25)
82 while
(step-statement statement
)
83 collect
(list (statement-column-value statement
0) (statement-column-value statement
1) (statement-column-value statement
2))
84 finally
(finalize-statement statement
))
85 '((1 "joe" 18) (2 "dvk" 22))))))
87 (test test-loop-with-prepared-statement
/named
88 (with-inserted-data (db)
90 (prepare-statement db
"select id, user_name, age from users where age < $x")))
93 (is (equalp (statement-column-names statement
)
94 '("id" "user_name" "age")))
95 (is (equalp (statement-bind-parameter-names statement
)
97 (bind-parameter statement
"$x" 25)
99 (loop while
(step-statement statement
)
100 collect
(list (statement-column-value statement
0)
101 (statement-column-value statement
1)
102 (statement-column-value statement
2))
103 finally
(reset-statement statement
))))
104 (is (equalp (fetch-all) '((1 "joe" 18) (2 "dvk" 22))))
105 (is (equalp (fetch-all) '((1 "joe" 18) (2 "dvk" 22))))
106 (clear-statement-bindings statement
)
107 (is (equalp (fetch-all) '()))))
108 (finalize-statement statement
)))))
111 (defparameter *db-file
* "/tmp/test.sqlite")
114 (defun ensure-table ()
115 (with-open-database (db *db-file
*)
116 (execute-non-query db
"CREATE TABLE IF NOT EXISTS FOO (v NUMERIC)")))
119 (test test-concurrent-inserts
120 (when (probe-file *db-file
*)
121 (delete-file *db-file
*))
124 (do-zillions 10 10000)
125 (when (probe-file *db-file
*)
126 (delete-file *db-file
*))))
129 (defun do-insert (n timeout
)
130 "Insert a nonsense value into foo"
132 (with-open-database (db *db-file
* :busy-timeout timeout
)
134 (execute-non-query db
"INSERT INTO FOO (v) VALUES (?)" n
)))
138 (defun do-zillions (max-n timeout
)
139 (iterate (for n from
1 to max-n
)
141 (bt:make-thread
(let ((n n
))
143 (do-insert n timeout
))))
146 (iter (for thread in threads
)
148 (for thread-result
= (bt:join-thread thread
))
149 (unless thread-result
151 (finally (is-true all-ok
"One of inserter threads encountered a SQLITE_BUSY error"))))))