PageRenderTime 29ms CodeModel.GetById 18ms RepoModel.GetById 0ms app.codeStats 0ms

/sqlite-tests.lisp

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