/usr/share/common-lisp/source/sqlite/sqlite-tests.lisp is in cl-sqlite 20130615-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | (defpackage :sqlite-tests
(:use :cl :sqlite :5am :iter :bordeaux-threads)
(:export :run-all-tests))
(in-package :sqlite-tests)
(def-suite sqlite-suite)
(defun run-all-tests ()
(run! 'sqlite-suite))
(in-suite sqlite-suite)
(test test-connect
(with-open-database (db ":memory:")))
(test test-disconnect-with-statements
(finishes
(with-open-database (db ":memory:")
(prepare-statement db "create table users (id integer primary key, user_name text not null, age integer null)"))))
(defmacro with-inserted-data ((db) &body body)
`(with-open-database (,db ":memory:")
(execute-non-query ,db "create table users (id integer primary key, user_name text not null, age integer null)")
(execute-non-query ,db "insert into users (user_name, age) values (?, ?)" "joe" 18)
(execute-non-query ,db "insert into users (user_name, age) values (?, ?)" "dvk" 22)
(execute-non-query ,db "insert into users (user_name, age) values (?, ?)" "qwe" 30)
,@body))
(test create-table-insert-and-error
(with-inserted-data (db)
(signals sqlite-constraint-error
(execute-non-query db "insert into users (user_name, age) values (?, ?)" nil nil))))
(test create-table-insert-and-error/named
(with-inserted-data (db)
(signals sqlite-constraint-error
(execute-non-query/named db "insert into users (user_name, age) values (:name, :age)" ":name" nil ":age" nil))))
(test test-select-single
(with-inserted-data (db)
(is (= (execute-single db "select id from users where user_name = ?" "dvk")
2))))
(test test-select-single/named
(with-inserted-data (db)
(is (= (execute-single/named db "select id from users where user_name = :name" ":name" "dvk")
2))))
(test test-select-m-v
(with-inserted-data (db)
(is (equalp (multiple-value-list (execute-one-row-m-v db "select id, user_name, age from users where user_name = ?" "joe"))
(list 1 "joe" 18)))))
(test test-select-m-v/named
(with-inserted-data (db)
(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"))
(list 1 "joe" 18)))))
(test test-select-list
(with-inserted-data (db)
(is (equalp (execute-to-list db "select id, user_name, age from users")
'((1 "joe" 18) (2 "dvk" 22) (3 "qwe" 30))))))
(test test-iterate
(with-inserted-data (db)
(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))
(collect (list id user-name age)))
'((1 "joe" 18) (2 "dvk" 22))))))
(test test-iterate/named
(with-inserted-data (db)
(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))
(collect (list id user-name age)))
'((1 "joe" 18) (2 "dvk" 22))))))
(test test-loop-with-prepared-statement
(with-inserted-data (db)
(is (equalp (loop
with statement = (prepare-statement db "select id, user_name, age from users where age < ?")
initially (bind-parameter statement 1 25)
while (step-statement statement)
collect (list (statement-column-value statement 0) (statement-column-value statement 1) (statement-column-value statement 2))
finally (finalize-statement statement))
'((1 "joe" 18) (2 "dvk" 22))))))
(test test-loop-with-prepared-statement/named
(with-inserted-data (db)
(let ((statement
(prepare-statement db "select id, user_name, age from users where age < $x")))
(unwind-protect
(progn
(is (equalp (statement-column-names statement)
'("id" "user_name" "age")))
(is (equalp (statement-bind-parameter-names statement)
'("$x")))
(bind-parameter statement "$x" 25)
(flet ((fetch-all ()
(loop while (step-statement statement)
collect (list (statement-column-value statement 0)
(statement-column-value statement 1)
(statement-column-value statement 2))
finally (reset-statement statement))))
(is (equalp (fetch-all) '((1 "joe" 18) (2 "dvk" 22))))
(is (equalp (fetch-all) '((1 "joe" 18) (2 "dvk" 22))))
(clear-statement-bindings statement)
(is (equalp (fetch-all) '()))))
(finalize-statement statement)))))
#+thread-support
(defparameter *db-file* "/tmp/test.sqlite")
#+thread-support
(defun ensure-table ()
(with-open-database (db *db-file*)
(execute-non-query db "CREATE TABLE IF NOT EXISTS FOO (v NUMERIC)")))
#+thread-support
(test test-concurrent-inserts
(when (probe-file *db-file*)
(delete-file *db-file*))
(ensure-table)
(unwind-protect
(do-zillions 10 10000)
(when (probe-file *db-file*)
(delete-file *db-file*))))
#+thread-support
(defun do-insert (n timeout)
"Insert a nonsense value into foo"
(ignore-errors
(with-open-database (db *db-file* :busy-timeout timeout)
(iter (repeat 10000)
(execute-non-query db "INSERT INTO FOO (v) VALUES (?)" n)))
t))
#+thread-support
(defun do-zillions (max-n timeout)
(iterate (for n from 1 to max-n)
(collect
(bt:make-thread (let ((n n))
(lambda ()
(do-insert n timeout))))
into threads)
(finally
(iter (for thread in threads)
(for all-ok = t)
(for thread-result = (bt:join-thread thread))
(unless thread-result
(setf all-ok nil))
(finally (is-true all-ok "One of inserter threads encountered a SQLITE_BUSY error"))))))
|