/sqlite-tests.lisp
Lisp | 151 lines | 128 code | 23 blank | 0 comment | 2 complexity | fbaedb7004eb13de71efd7c9bf5f6c51 MD5 | raw file
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"))))))