| 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; |
| 4 | ;;; This file is part of GNU Guix. |
| 5 | ;;; |
| 6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
| 7 | ;;; under the terms of the GNU General Public License as published by |
| 8 | ;;; the Free Software Foundation; either version 3 of the License, or (at |
| 9 | ;;; your option) any later version. |
| 10 | ;;; |
| 11 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
| 12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU General Public License for more details. |
| 15 | ;;; |
| 16 | ;;; You should have received a copy of the GNU General Public License |
| 17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
| 18 | |
| 19 | (define-module (test-store-database) |
| 20 | #:use-module (guix tests) |
| 21 | #:use-module (guix store) |
| 22 | #:use-module (guix store database) |
| 23 | #:use-module ((guix utils) #:select (call-with-temporary-output-file)) |
| 24 | #:use-module (srfi srfi-26) |
| 25 | #:use-module (srfi srfi-64)) |
| 26 | |
| 27 | ;; Test the (guix store database) module. |
| 28 | |
| 29 | (define %store |
| 30 | (open-connection-for-tests)) |
| 31 | |
| 32 | \f |
| 33 | (test-begin "store-database") |
| 34 | |
| 35 | (test-equal "register-path" |
| 36 | '(1 1) |
| 37 | (let ((file (string-append (%store-prefix) "/" (make-string 32 #\f) |
| 38 | "-fake"))) |
| 39 | (when (valid-path? %store file) |
| 40 | (delete-paths %store (list file))) |
| 41 | (false-if-exception (delete-file file)) |
| 42 | |
| 43 | (let ((ref (add-text-to-store %store "ref-of-fake" (random-text))) |
| 44 | (drv (string-append file ".drv"))) |
| 45 | (call-with-output-file file |
| 46 | (cut display "This is a fake store item.\n" <>)) |
| 47 | (register-path file |
| 48 | #:references (list ref) |
| 49 | #:deriver drv) |
| 50 | |
| 51 | (and (valid-path? %store file) |
| 52 | (equal? (references %store file) (list ref)) |
| 53 | (null? (valid-derivers %store file)) |
| 54 | (null? (referrers %store file)) |
| 55 | (list (stat:mtime (lstat file)) |
| 56 | (stat:mtime (lstat ref))))))) |
| 57 | |
| 58 | (test-equal "new database" |
| 59 | (list 1 2) |
| 60 | (call-with-temporary-output-file |
| 61 | (lambda (db-file port) |
| 62 | (delete-file db-file) |
| 63 | (with-database db-file db |
| 64 | (sqlite-register db |
| 65 | #:path "/gnu/foo" |
| 66 | #:references '() |
| 67 | #:deriver "/gnu/foo.drv" |
| 68 | #:hash (string-append "sha256:" (make-string 64 #\e)) |
| 69 | #:nar-size 1234) |
| 70 | (sqlite-register db |
| 71 | #:path "/gnu/bar" |
| 72 | #:references '("/gnu/foo") |
| 73 | #:deriver "/gnu/bar.drv" |
| 74 | #:hash (string-append "sha256:" (make-string 64 #\a)) |
| 75 | #:nar-size 4321) |
| 76 | (let ((path-id (@@ (guix store database) path-id))) |
| 77 | (list (path-id db "/gnu/foo") |
| 78 | (path-id db "/gnu/bar"))))))) |
| 79 | |
| 80 | (test-assert "register-path with unregistered references" |
| 81 | ;; Make sure we get a "NOT NULL constraint failed: Refs.reference" error |
| 82 | ;; when we try to add references that are not registered yet. Better safe |
| 83 | ;; than sorry. |
| 84 | (call-with-temporary-output-file |
| 85 | (lambda (db-file port) |
| 86 | (delete-file db-file) |
| 87 | (catch 'sqlite-error |
| 88 | (lambda () |
| 89 | (with-database db-file db |
| 90 | (sqlite-register db #:path "/gnu/foo" |
| 91 | #:references '("/gnu/bar") |
| 92 | #:deriver "/gnu/foo.drv" |
| 93 | #:hash (string-append "sha256:" (make-string 64 #\e)) |
| 94 | #:nar-size 1234)) |
| 95 | #f) |
| 96 | (lambda args |
| 97 | (pk 'welcome-exception! args) |
| 98 | #t))))) |
| 99 | |
| 100 | (test-end "store-database") |