sqlite-tests.lisp

   1 (defpackage :sqlite-tests
   2   (:use :cl :sqlite :5am :iter :bordeaux-threads)
   3   (:export :run-all-tests))
   4
   5 (in-package :sqlite-tests)
   6
   7 (def-suite sqlite-suite)
   8
   9 (defun run-all-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"))))))