basic.scm 3.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127
  1. ;;;; basic.scm --- -*- mode: scheme; coding: utf-8; -*-
  2. ;;;;
  3. ;;;; Copyright (C) 2011 Detlev Zundel <dzu@denx.de>
  4. ;;;; Copyright (C) 2018 Ludovic Courtès <ludo@gnu.org>
  5. ;;;;
  6. ;;;; This library is free software; you can redistribute it and/or
  7. ;;;; modify it under the terms of the GNU Lesser General Public
  8. ;;;; License as published by the Free Software Foundation; either
  9. ;;;; version 3 of the License, or (at your option) any later version.
  10. ;;;;
  11. ;;;; This library is distributed in the hope that it will be useful,
  12. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  14. ;;;; Lesser General Public License for more details.
  15. ;;;;
  16. ;;;; You should have received a copy of the GNU Lesser General Public
  17. ;;;; License along with this library; if not, write to the Free Software
  18. ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19. (define-module (tests basic-test)
  20. #:use-module (srfi srfi-64)
  21. #:use-module (ice-9 format)
  22. #:use-module (rnrs bytevectors)
  23. #:use-module (sqlite3))
  24. (define (sqlite-exec* db sql key value)
  25. (let ((stmt (sqlite-prepare db sql)))
  26. (sqlite-bind stmt key value)
  27. (sqlite-map display stmt)
  28. (sqlite-finalize stmt)
  29. #t))
  30. ;; Cleanup database so we can check creation
  31. (define db-name "tests/simple.db")
  32. (if (file-exists? db-name)
  33. (begin
  34. (format #t "Removing leftover database ~a~%" db-name)
  35. (delete-file db-name)))
  36. (define db
  37. ;; Global database used for tests.
  38. #f)
  39. (test-begin "basic")
  40. (test-assert "sqlite-open"
  41. (begin
  42. (set! db (sqlite-open db-name (logior SQLITE_OPEN_CREATE
  43. SQLITE_OPEN_READWRITE)))
  44. (sqlite-db? db)))
  45. (test-assert "sqlite-busy-timeout"
  46. (sqlite-busy-timeout db 20))
  47. (test-assert "create table"
  48. (sqlite-exec db
  49. "create table project (
  50. reference integer primary key,
  51. name text,
  52. website text
  53. )"))
  54. (test-assert "insert"
  55. (sqlite-exec db
  56. "insert into project values (1, 'Guile', '');
  57. insert into project values (2, 'Guix', 'gnu.org');"))
  58. (test-assert "sqlite-prepare with caching"
  59. (let* ((s "SELECT * FROM project")
  60. (stmt (sqlite-prepare db s #:cache? #t)))
  61. (eq? stmt (sqlite-prepare db s #:cache? #t))))
  62. (test-equal "select"
  63. '(#(1 "Guile" "") #(2 "Guix" "gnu.org"))
  64. (let* ((stmt (sqlite-prepare db "select * from project"))
  65. (result (sqlite-map identity stmt)))
  66. (sqlite-finalize stmt)
  67. result))
  68. (test-assert "select with named parameters"
  69. (sqlite-exec* db "select * from project where 'bla' = :foo" ":foo" "bla"))
  70. (test-assert "select with named parameters, alternate form"
  71. (sqlite-exec* db "select * from project where 'bla' = :foo" 'foo "bla"))
  72. (test-assert "insert with sqlite-bind"
  73. (begin
  74. (sqlite-exec db "CREATE TABLE foos (dbid INTEGER PRIMARY KEY, name TEXT)")
  75. (let ((stmt (sqlite-prepare db "INSERT INTO foos(name) VALUES(?)")))
  76. (sqlite-bind stmt 1 "myfoo")
  77. (sqlite-step stmt)
  78. (sqlite-finalize stmt)
  79. #t)))
  80. (test-assert "drop"
  81. (sqlite-exec db "DROP TABLE IF EXISTS foos"))
  82. (define bv
  83. (let* ((n 1023)
  84. (v (make-bytevector n)))
  85. (do ((i 0 (1+ i)))
  86. ((>= i n))
  87. (bytevector-u8-set! v i (random 256)))
  88. v))
  89. (test-assert "insert blob"
  90. (begin
  91. (sqlite-exec db "CREATE TABLE cow (biggie blob)")
  92. (let ((stmt (sqlite-prepare db "INSERT INTO cow (biggie) VALUES(?)")))
  93. (sqlite-bind stmt 1 bv)
  94. (sqlite-step stmt)
  95. (sqlite-finalize stmt)
  96. #t)))
  97. (test-assert "select blob"
  98. (let* ((stmt (sqlite-prepare db "SELECT biggie from cow"))
  99. (res (vector-ref (car (sqlite-map identity stmt)) 0)))
  100. ; (display res)(newline)
  101. ; (display bv)(newline)
  102. (bytevector=? res bv)))
  103. (sqlite-close db)
  104. (delete-file db-name)
  105. (test-end "basic")