| 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2016, 2017 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-scripts-build) |
| 20 | #:use-module (guix tests) |
| 21 | #:use-module (guix store) |
| 22 | #:use-module (guix packages) |
| 23 | #:use-module (guix scripts build) |
| 24 | #:use-module (guix ui) |
| 25 | #:use-module (guix utils) |
| 26 | #:use-module (gnu packages) |
| 27 | #:use-module (gnu packages base) |
| 28 | #:use-module (gnu packages busybox) |
| 29 | #:use-module (ice-9 match) |
| 30 | #:use-module (srfi srfi-64)) |
| 31 | |
| 32 | \f |
| 33 | (test-begin "scripts-build") |
| 34 | |
| 35 | (test-assert "options->transformation, no transformations" |
| 36 | (let ((p (dummy-package "foo")) |
| 37 | (t (options->transformation '()))) |
| 38 | (with-store store |
| 39 | (eq? (t store p) p)))) |
| 40 | |
| 41 | (test-assert "options->transformation, with-source" |
| 42 | ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm' source should |
| 43 | ;; be applicable. |
| 44 | (let* ((p (dummy-package "guix.scm")) |
| 45 | (s (search-path %load-path "guix.scm")) |
| 46 | (t (options->transformation `((with-source . ,s))))) |
| 47 | (with-store store |
| 48 | (let ((new (t store p))) |
| 49 | (and (not (eq? new p)) |
| 50 | (string=? (package-source new) |
| 51 | (add-to-store store "guix.scm" #t |
| 52 | "sha256" s))))))) |
| 53 | |
| 54 | (test-assert "options->transformation, with-source, replacement" |
| 55 | ;; Same, but this time the original package has a 'replacement' field. We |
| 56 | ;; expect that replacement to be set to #f in the new package. |
| 57 | (let* ((p (dummy-package "guix.scm" (replacement coreutils))) |
| 58 | (s (search-path %load-path "guix.scm")) |
| 59 | (t (options->transformation `((with-source . ,s))))) |
| 60 | (with-store store |
| 61 | (let ((new (t store p))) |
| 62 | (and (not (eq? new p)) |
| 63 | (string=? (package-source new) |
| 64 | (add-to-store store "guix.scm" #t "sha256" s)) |
| 65 | (not (package-replacement new))))))) |
| 66 | |
| 67 | (test-assert "options->transformation, with-source, with version" |
| 68 | ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm-2.0' source |
| 69 | ;; should be applicable, and its version should be extracted. |
| 70 | (let ((p (dummy-package "foo")) |
| 71 | (s (search-path %load-path "guix.scm"))) |
| 72 | (call-with-temporary-directory |
| 73 | (lambda (directory) |
| 74 | (let* ((f (string-append directory "/foo-42.0.tar.gz")) |
| 75 | (t (options->transformation `((with-source . ,f))))) |
| 76 | (copy-file s f) |
| 77 | (with-store store |
| 78 | (let ((new (t store p))) |
| 79 | (and (not (eq? new p)) |
| 80 | (string=? (package-name new) (package-name p)) |
| 81 | (string=? (package-version new) "42.0") |
| 82 | (string=? (package-source new) |
| 83 | (add-to-store store (basename f) #t |
| 84 | "sha256" f)))))))))) |
| 85 | |
| 86 | (test-assert "options->transformation, with-source, no matches" |
| 87 | ;; When a transformation in not applicable, a warning must be raised. |
| 88 | (let* ((p (dummy-package "foobar")) |
| 89 | (s (search-path %load-path "guix.scm")) |
| 90 | (t (options->transformation `((with-source . ,s))))) |
| 91 | (with-store store |
| 92 | (let* ((port (open-output-string)) |
| 93 | (new (parameterize ((guix-warning-port port)) |
| 94 | (t store p)))) |
| 95 | (and (eq? new p) |
| 96 | (string-contains (get-output-string port) |
| 97 | "had no effect")))))) |
| 98 | |
| 99 | (test-assert "options->transformation, with-source, PKG=URI" |
| 100 | (let* ((p (dummy-package "foo")) |
| 101 | (s (search-path %load-path "guix.scm")) |
| 102 | (f (string-append "foo=" s)) |
| 103 | (t (options->transformation `((with-source . ,f))))) |
| 104 | (with-store store |
| 105 | (let ((new (t store p))) |
| 106 | (and (not (eq? new p)) |
| 107 | (string=? (package-name new) (package-name p)) |
| 108 | (string=? (package-version new) |
| 109 | (package-version p)) |
| 110 | (string=? (package-source new) |
| 111 | (add-to-store store (basename s) #t |
| 112 | "sha256" s))))))) |
| 113 | |
| 114 | (test-assert "options->transformation, with-source, PKG@VER=URI" |
| 115 | (let* ((p (dummy-package "foo")) |
| 116 | (s (search-path %load-path "guix.scm")) |
| 117 | (f (string-append "foo@42.0=" s)) |
| 118 | (t (options->transformation `((with-source . ,f))))) |
| 119 | (with-store store |
| 120 | (let ((new (t store p))) |
| 121 | (and (not (eq? new p)) |
| 122 | (string=? (package-name new) (package-name p)) |
| 123 | (string=? (package-version new) "42.0") |
| 124 | (string=? (package-source new) |
| 125 | (add-to-store store (basename s) #t |
| 126 | "sha256" s))))))) |
| 127 | |
| 128 | (test-assert "options->transformation, with-input" |
| 129 | (let* ((p (dummy-package "guix.scm" |
| 130 | (inputs `(("foo" ,(specification->package "coreutils")) |
| 131 | ("bar" ,(specification->package "grep")) |
| 132 | ("baz" ,(dummy-package "chbouib" |
| 133 | (native-inputs `(("x" ,grep))))))))) |
| 134 | (t (options->transformation '((with-input . "coreutils=busybox") |
| 135 | (with-input . "grep=findutils"))))) |
| 136 | (with-store store |
| 137 | (let ((new (t store p))) |
| 138 | (and (not (eq? new p)) |
| 139 | (match (package-inputs new) |
| 140 | ((("foo" dep1) ("bar" dep2) ("baz" dep3)) |
| 141 | (and (eq? dep1 busybox) |
| 142 | (eq? dep2 findutils) |
| 143 | (string=? (package-name dep3) "chbouib") |
| 144 | (match (package-native-inputs dep3) |
| 145 | ((("x" dep)) |
| 146 | (eq? dep findutils))))))))))) |
| 147 | |
| 148 | (test-assert "options->transformation, with-graft" |
| 149 | (let* ((p (dummy-package "guix.scm" |
| 150 | (inputs `(("foo" ,grep) |
| 151 | ("bar" ,(dummy-package "chbouib" |
| 152 | (native-inputs `(("x" ,grep))))))))) |
| 153 | (t (options->transformation '((with-graft . "grep=findutils"))))) |
| 154 | (with-store store |
| 155 | (let ((new (t store p))) |
| 156 | (and (not (eq? new p)) |
| 157 | (match (package-inputs new) |
| 158 | ((("foo" dep1) ("bar" dep2)) |
| 159 | (and (string=? (package-full-name dep1) |
| 160 | (package-full-name grep)) |
| 161 | (eq? (package-replacement dep1) findutils) |
| 162 | (string=? (package-name dep2) "chbouib") |
| 163 | (match (package-native-inputs dep2) |
| 164 | ((("x" dep)) |
| 165 | (eq? (package-replacement dep) findutils))))))))))) |
| 166 | |
| 167 | (test-end) |