/sqlite-tests.lisp

  1(defpackage :sqlite-tests
  2  (:use :cl :sqlite :5am :iter :bordeaux-threads)
  3  (:export :run-all-sqlite-tests))
  4
  5(in-package :sqlite-tests)
  6
  7(def-suite sqlite-suite)
  8
  9(defun run-all-sqlite-tests ()
 10  (run! 'sqlite-suite))
 11
 12(in-suite sqlite-suite)
 13
 14(test test-connect
 15  (with-open-database (db ":memory:")))
 16
 17(test test-disconnect-with-statements
 18  (finishes
 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)"))))
 21
 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)
 28     ,@body))
 29
 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))))
 34
 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))))
 39
 40(test test-select-single
 41  (with-inserted-data (db)
 42    (is (= (execute-single db "select id from users where user_name = ?" "dvk")
 43           2))))
 44
 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")
 48           2))))
 49
 50(test test-select-m-v
 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"))
 53                (list 1 "joe" 18)))))
 54
 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"))
 58                (list 1 "joe" 18)))))
 59
 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))))))
 64
 65(test test-iterate
 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))))))
 70
 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))))))
 76
 77(test test-loop-with-prepared-statement
 78  (with-inserted-data (db)
 79    (is (equalp (loop
 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))))))
 86
 87(test test-loop-with-prepared-statement/named
 88  (with-inserted-data (db)
 89    (let ((statement
 90           (prepare-statement db "select id, user_name, age from users where age < $x")))
 91      (unwind-protect
 92           (progn
 93             (is (equalp (statement-column-names statement)
 94                         '("id" "user_name" "age")))
 95             (is (equalp (statement-bind-parameter-names statement)
 96                         '("$x")))
 97             (bind-parameter statement "$x" 25)
 98             (flet ((fetch-all ()
 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)))))
109
110#+thread-support
111(defparameter *db-file* "/tmp/test.sqlite")
112
113#+thread-support
114(defun ensure-table ()
115  (with-open-database (db *db-file*)
116    (execute-non-query db "CREATE TABLE IF NOT EXISTS FOO (v NUMERIC)")))
117
118#+thread-support
119(test test-concurrent-inserts
120  (when (probe-file *db-file*)
121    (delete-file *db-file*))
122  (ensure-table)
123  (unwind-protect
124       (do-zillions 10 10000)
125    (when (probe-file *db-file*)
126    (delete-file *db-file*))))
127
128#+thread-support
129(defun do-insert (n timeout)
130  "Insert a nonsense value into foo"
131  (ignore-errors
132    (with-open-database (db *db-file* :busy-timeout timeout)
133      (iter (repeat 10000)
134            (execute-non-query db "INSERT INTO FOO (v) VALUES (?)" n)))
135    t))
136
137#+thread-support
138(defun do-zillions (max-n timeout)
139  (iterate (for n from 1 to max-n)
140           (collect 
141               (bt:make-thread (let ((n n))
142                                 (lambda ()
143                                   (do-insert n timeout))))
144             into threads)
145           (finally
146            (iter (for thread in threads)
147                  (for all-ok = t)
148                  (for thread-result = (bt:join-thread thread))
149                  (unless thread-result
150                    (setf all-ok nil))
151                  (finally (is-true all-ok "One of inserter threads encountered a SQLITE_BUSY error"))))))