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 error
  33       (execute-non-query db "insert into users (user_name, age) values (?, ?)" nil nil))))
  34
  35 (test test-select-single
  36   (with-inserted-data (db)
  37     (is (= (execute-single db "select id from users where user_name = ?" "dvk")
  38            2))))
  39
  40 (test test-select-m-v
  41   (with-inserted-data (db)
  42     (is (equalp (multiple-value-list (execute-one-row-m-v db "select id, user_name, age from users where user_name = ?" "joe"))
  43                 (list 1 "joe" 18)))))
  44
  45 (test test-select-list
  46   (with-inserted-data (db)
  47     (is (equalp (execute-to-list db "select id, user_name, age from users")
  48                 '((1 "joe" 18) (2 "dvk" 22) (3 "qwe" 30))))))
  49
  50 (test test-iterate
  51   (with-inserted-data (db)
  52     (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))
  53                       (collect (list id user-name age)))
  54                 '((1 "joe" 18) (2 "dvk" 22))))))
  55
  56 (test test-loop-with-prepared-statement
  57   (with-inserted-data (db)
  58     (is (equalp (loop
  59                    with statement = (prepare-statement db "select id, user_name, age from users where age < ?")
  60                    initially (bind-parameter statement 1 25)
  61                    while (step-statement statement)
  62                    collect (list (statement-column-value statement 0) (statement-column-value statement 1) (statement-column-value statement 2))
  63                    finally (finalize-statement statement))
  64                 '((1 "joe" 18) (2 "dvk" 22))))))
  65
  66 #+thread-support
  67 (defparameter *db-file* "/tmp/test.sqlite")
  68
  69 #+thread-support
  70 (defun ensure-table ()
  71   (with-open-database (db *db-file*)
  72     (execute-non-query db "CREATE TABLE IF NOT EXISTS FOO (v NUMERIC)")))
  73
  74 #+thread-support
  75 (test test-concurrent-inserts
  76   (when (probe-file *db-file*)
  77     (delete-file *db-file*))
  78   (ensure-table)
  79   (unwind-protect
  80        (do-zillions 10 10000)
  81     (when (probe-file *db-file*)
  82     (delete-file *db-file*))))
  83
  84 #+thread-support
  85 (defun do-insert (n timeout)
  86   "Insert a nonsense value into foo"
  87   (ignore-errors
  88     (with-open-database (db *db-file* :busy-timeout timeout)
  89       (iter (repeat 10000)
  90             (execute-non-query db "INSERT INTO FOO (v) VALUES (?)" n)))
  91     t))
  92
  93 #+thread-support
  94 (defun do-zillions (max-n timeout)
  95   (iterate (for n from 1 to max-n)
  96            (collect
  97                (bt:make-thread (let ((n n))
  98                                  (lambda ()
  99                                    (do-insert n timeout))))
 100              into threads)
 101            (finally
 102             (iter (for thread in threads)
 103                   (for all-ok = t)
 104                   (for thread-result = (bt:join-thread thread))
 105                   (unless thread-result
 106                     (setf all-ok nil))
 107                   (finally (is-true all-ok "One of inserter threads encountered a SQLITE_BUSY error"))))))