diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-01-22 22:42:57 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-01-23 22:23:41 +0100 |
| commit | fcd75bdbfa99d14363b905afbf914eec20e69df8 (patch) | |
| tree | 38f9cfaf9c186fc6c9af54183efbd02fa1a13f70 /tests | |
| parent | c5746f239964a72642ac56640b8ff490d5bfa673 (diff) | |
search-paths: Allow specs with #f as their separator.
This adds support for single-entry search paths.
Fixes <http://bugs.gnu.org/25422>.
Reported by Leo Famulari <leo@famulari.name>.
* guix/search-paths.scm (<search-path-specification>)[separator]:
Document as string or #f.
(evaluate-search-paths): Add case for SEPARATOR as #f.
(environment-variable-definition): Handle SEPARATOR being #f.
* guix/build/utils.scm (list->search-path-as-string): Add case for
SEPARATOR as #f.
(search-path-as-string->list): Likewise.
* guix/build/profiles.scm (abstract-profile): Likewise.
* tests/search-paths.scm: New file.
* Makefile.am (SCM_TESTS): Add it.
* tests/packages.scm ("--search-paths with single-item search path"):
New test.
* gnu/packages/version-control.scm (git)[native-search-paths](separator):
New field.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/packages.scm | 49 | ||||
| -rw-r--r-- | tests/search-paths.scm | 48 |
2 files changed, 96 insertions, 1 deletions
diff --git a/tests/packages.scm b/tests/packages.scm index 247f75cc435..962f120ea2c 100644 --- a/tests/packages.scm +++ b/tests/packages.scm | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; | 3 | ;;; |
| 4 | ;;; This file is part of GNU Guix. | 4 | ;;; This file is part of GNU Guix. |
| 5 | ;;; | 5 | ;;; |
| @@ -42,6 +42,7 @@ | |||
| 42 | #:use-module (gnu packages base) | 42 | #:use-module (gnu packages base) |
| 43 | #:use-module (gnu packages guile) | 43 | #:use-module (gnu packages guile) |
| 44 | #:use-module (gnu packages bootstrap) | 44 | #:use-module (gnu packages bootstrap) |
| 45 | #:use-module (gnu packages version-control) | ||
| 45 | #:use-module (gnu packages xml) | 46 | #:use-module (gnu packages xml) |
| 46 | #:use-module (srfi srfi-1) | 47 | #:use-module (srfi srfi-1) |
| 47 | #:use-module (srfi srfi-26) | 48 | #:use-module (srfi srfi-26) |
| @@ -979,6 +980,52 @@ | |||
| 979 | (guix-package "-p" (derivation->output-path prof) | 980 | (guix-package "-p" (derivation->output-path prof) |
| 980 | "--search-paths")))))) | 981 | "--search-paths")))))) |
| 981 | 982 | ||
| 983 | (test-assert "--search-paths with single-item search path" | ||
| 984 | ;; Make sure 'guix package --search-paths' correctly reports environment | ||
| 985 | ;; variables for things like 'GIT_SSL_CAINFO' that have #f as their | ||
| 986 | ;; separator, meaning that the first match wins. | ||
| 987 | (let* ((p1 (dummy-package "foo" | ||
| 988 | (build-system trivial-build-system) | ||
| 989 | (arguments | ||
| 990 | `(#:guile ,%bootstrap-guile | ||
| 991 | #:modules ((guix build utils)) | ||
| 992 | #:builder (begin | ||
| 993 | (use-modules (guix build utils)) | ||
| 994 | (let ((out (assoc-ref %outputs "out"))) | ||
| 995 | (mkdir-p (string-append out "/etc/ssl/certs")) | ||
| 996 | (call-with-output-file | ||
| 997 | (string-append | ||
| 998 | out "/etc/ssl/certs/ca-certificates.crt") | ||
| 999 | (const #t)))))))) | ||
| 1000 | (p2 (package (inherit p1) (name "bar"))) | ||
| 1001 | (p3 (dummy-package "git" | ||
| 1002 | ;; Provide a fake Git to avoid building the real one. | ||
| 1003 | (build-system trivial-build-system) | ||
| 1004 | (arguments | ||
| 1005 | `(#:guile ,%bootstrap-guile | ||
| 1006 | #:builder (mkdir (assoc-ref %outputs "out")))) | ||
| 1007 | (native-search-paths (package-native-search-paths git)))) | ||
| 1008 | (prof1 (run-with-store %store | ||
| 1009 | (profile-derivation | ||
| 1010 | (packages->manifest (list p1 p3)) | ||
| 1011 | #:hooks '() | ||
| 1012 | #:locales? #f) | ||
| 1013 | #:guile-for-build (%guile-for-build))) | ||
| 1014 | (prof2 (run-with-store %store | ||
| 1015 | (profile-derivation | ||
| 1016 | (packages->manifest (list p2 p3)) | ||
| 1017 | #:hooks '() | ||
| 1018 | #:locales? #f) | ||
| 1019 | #:guile-for-build (%guile-for-build)))) | ||
| 1020 | (build-derivations %store (list prof1 prof2)) | ||
| 1021 | (string-match (format #f "^export GIT_SSL_CAINFO=\"~a/etc/ssl/certs/ca-certificates.crt" | ||
| 1022 | (regexp-quote (derivation->output-path prof1))) | ||
| 1023 | (with-output-to-string | ||
| 1024 | (lambda () | ||
| 1025 | (guix-package "-p" (derivation->output-path prof1) | ||
| 1026 | "-p" (derivation->output-path prof2) | ||
| 1027 | "--search-paths")))))) | ||
| 1028 | |||
| 982 | (test-equal "specification->package when not found" | 1029 | (test-equal "specification->package when not found" |
| 983 | 'quit | 1030 | 'quit |
| 984 | (catch 'quit | 1031 | (catch 'quit |
diff --git a/tests/search-paths.scm b/tests/search-paths.scm new file mode 100644 index 00000000000..2a4c18dd768 --- /dev/null +++ b/tests/search-paths.scm | |||
| @@ -0,0 +1,48 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | ||
| 2 | ;;; Copyright © 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-search-paths) | ||
| 20 | #:use-module (guix search-paths) | ||
| 21 | #:use-module (ice-9 match) | ||
| 22 | #:use-module (srfi srfi-64)) | ||
| 23 | |||
| 24 | (define %top-srcdir | ||
| 25 | (dirname (search-path %load-path "guix.scm"))) | ||
| 26 | |||
| 27 | |||
| 28 | (test-begin "search-paths") | ||
| 29 | |||
| 30 | (test-equal "evaluate-search-paths, separator is #f" | ||
| 31 | (string-append %top-srcdir | ||
| 32 | "/gnu/packages/bootstrap/armhf-linux") | ||
| 33 | |||
| 34 | ;; The following search path spec should evaluate to a single item: the | ||
| 35 | ;; first directory that matches the "-linux$" pattern in | ||
| 36 | ;; gnu/packages/bootstrap. | ||
| 37 | (let ((spec (search-path-specification | ||
| 38 | (variable "CHBOUIB") | ||
| 39 | (files '("gnu/packages/bootstrap")) | ||
| 40 | (file-type 'directory) | ||
| 41 | (separator #f) | ||
| 42 | (file-pattern "-linux$")))) | ||
| 43 | (match (evaluate-search-paths (list spec) | ||
| 44 | (list %top-srcdir)) | ||
| 45 | (((spec* . value)) | ||
| 46 | (and (eq? spec* spec) value))))) | ||
| 47 | |||
| 48 | (test-end "search-paths") | ||
