basic.scm 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139
  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 (system foreign)
  23. #:use-module (rnrs bytevectors)
  24. #:use-module (sqlite3))
  25. (define (sqlite-exec* db sql key value)
  26. (let ((stmt (sqlite-prepare db sql)))
  27. (sqlite-bind stmt key value)
  28. (sqlite-map display stmt)
  29. (sqlite-finalize stmt)
  30. #t))
  31. ;; Cleanup database so we can check creation
  32. (define db-name "tests/simple.db")
  33. (if (file-exists? db-name)
  34. (begin
  35. (format #t "Removing leftover database ~a~%" db-name)
  36. (delete-file db-name)))
  37. (define db
  38. ;; Global database used for tests.
  39. #f)
  40. (test-begin "basic")
  41. (test-assert "sqlite-open"
  42. (begin
  43. (set! db (sqlite-open db-name (logior SQLITE_OPEN_CREATE
  44. SQLITE_OPEN_READWRITE)))
  45. (sqlite-db? db)))
  46. (test-assert "sqlite-busy-timeout"
  47. (sqlite-busy-timeout db 20))
  48. (test-assert "create table"
  49. (sqlite-exec db
  50. "create table project (
  51. reference integer primary key,
  52. name text,
  53. website text
  54. )"))
  55. (test-assert "insert"
  56. (sqlite-exec db
  57. "insert into project values (1, 'Guile', '');
  58. insert into project values (2, 'Guix', 'gnu.org');"))
  59. (test-assert "sqlite-prepare with caching"
  60. (let* ((s "SELECT * FROM project")
  61. (stmt (sqlite-prepare db s #:cache? #t)))
  62. (eq? stmt (sqlite-prepare db s #:cache? #t))))
  63. (test-equal "select"
  64. '(#(1 "Guile" "") #(2 "Guix" "gnu.org"))
  65. (let* ((stmt (sqlite-prepare db "select * from project"))
  66. (result (sqlite-map identity stmt)))
  67. (sqlite-finalize stmt)
  68. (sqlite-finalize stmt) ; no-op
  69. result))
  70. (test-assert "select with named parameters"
  71. (sqlite-exec* db "select * from project where 'bla' = :foo" ":foo" "bla"))
  72. (test-assert "select with named parameters, alternate form"
  73. (sqlite-exec* db "select * from project where 'bla' = :foo" 'foo "bla"))
  74. (test-assert "insert with sqlite-bind"
  75. (begin
  76. (sqlite-exec db "CREATE TABLE foos (dbid INTEGER PRIMARY KEY, name TEXT)")
  77. (let ((stmt (sqlite-prepare db "INSERT INTO foos(name) VALUES(?)")))
  78. (sqlite-bind stmt 1 "myfoo")
  79. (sqlite-step stmt)
  80. (sqlite-finalize stmt)
  81. #t)))
  82. (test-assert "drop"
  83. (sqlite-exec db "DROP TABLE IF EXISTS foos"))
  84. (define bv
  85. (let* ((n 1023)
  86. (v (make-bytevector n)))
  87. (do ((i 0 (1+ i)))
  88. ((>= i n))
  89. (bytevector-u8-set! v i (random 256)))
  90. v))
  91. (test-assert "insert blob"
  92. (begin
  93. (sqlite-exec db "CREATE TABLE cow (biggie blob)")
  94. (let ((stmt (sqlite-prepare db "INSERT INTO cow (biggie) VALUES(?)")))
  95. (sqlite-bind stmt 1 bv)
  96. (sqlite-step stmt)
  97. (sqlite-finalize stmt)
  98. #t)))
  99. (test-assert "select blob"
  100. (let* ((stmt (sqlite-prepare db "SELECT biggie from cow"))
  101. (res (vector-ref (car (sqlite-map identity stmt)) 0)))
  102. ; (display res)(newline)
  103. ; (display bv)(newline)
  104. (bytevector=? res bv)))
  105. (begin
  106. (sqlite-trace db
  107. SQLITE_TRACE_STMT
  108. (lambda (trace p x)
  109. (test-assert "trace"
  110. (string=? (pointer->string
  111. (sqlite-expanded-sql p))
  112. "select * from project where 'bla' = 'bla'"))))
  113. (sqlite-exec* db "select * from project where 'bla' = :foo" 'foo "bla"))
  114. (sqlite-close db)
  115. (delete-file db-name)
  116. (test-end "basic")