diff options
Diffstat (limited to 'tests')
-rw-r--r-- | tests/guix-package-net.sh | 4 | ||||
-rw-r--r-- | tests/packages.scm | 49 | ||||
-rw-r--r-- | tests/search-paths.scm | 48 |
3 files changed, 98 insertions, 3 deletions
diff --git a/tests/guix-package-net.sh b/tests/guix-package-net.sh index 35ef6ff1a0..1eff6abba3 100644 --- a/tests/guix-package-net.sh +++ b/tests/guix-package-net.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2012, 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org> # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> # # This file is part of GNU Guix. @@ -165,7 +165,7 @@ guix package --bootstrap -p "$profile_alt" -i gcc-bootstrap if guix package -p "$profile" --search-paths | grep LIBRARY_PATH then false; fi guix package -p "$profile" -p "$profile_alt" --search-paths \ - | grep "LIBRARY_PATH.*$profile/lib" + | grep "LIBRARY_PATH.*$profile/lib.$profile_alt/lib" # # Try with the default profile. diff --git a/tests/packages.scm b/tests/packages.scm index 247f75cc43..962f120ea2 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -42,6 +42,7 @@ #:use-module (gnu packages base) #:use-module (gnu packages guile) #:use-module (gnu packages bootstrap) + #:use-module (gnu packages version-control) #:use-module (gnu packages xml) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -979,6 +980,52 @@ (guix-package "-p" (derivation->output-path prof) "--search-paths")))))) +(test-assert "--search-paths with single-item search path" + ;; Make sure 'guix package --search-paths' correctly reports environment + ;; variables for things like 'GIT_SSL_CAINFO' that have #f as their + ;; separator, meaning that the first match wins. + (let* ((p1 (dummy-package "foo" + (build-system trivial-build-system) + (arguments + `(#:guile ,%bootstrap-guile + #:modules ((guix build utils)) + #:builder (begin + (use-modules (guix build utils)) + (let ((out (assoc-ref %outputs "out"))) + (mkdir-p (string-append out "/etc/ssl/certs")) + (call-with-output-file + (string-append + out "/etc/ssl/certs/ca-certificates.crt") + (const #t)))))))) + (p2 (package (inherit p1) (name "bar"))) + (p3 (dummy-package "git" + ;; Provide a fake Git to avoid building the real one. + (build-system trivial-build-system) + (arguments + `(#:guile ,%bootstrap-guile + #:builder (mkdir (assoc-ref %outputs "out")))) + (native-search-paths (package-native-search-paths git)))) + (prof1 (run-with-store %store + (profile-derivation + (packages->manifest (list p1 p3)) + #:hooks '() + #:locales? #f) + #:guile-for-build (%guile-for-build))) + (prof2 (run-with-store %store + (profile-derivation + (packages->manifest (list p2 p3)) + #:hooks '() + #:locales? #f) + #:guile-for-build (%guile-for-build)))) + (build-derivations %store (list prof1 prof2)) + (string-match (format #f "^export GIT_SSL_CAINFO=\"~a/etc/ssl/certs/ca-certificates.crt" + (regexp-quote (derivation->output-path prof1))) + (with-output-to-string + (lambda () + (guix-package "-p" (derivation->output-path prof1) + "-p" (derivation->output-path prof2) + "--search-paths")))))) + (test-equal "specification->package when not found" 'quit (catch 'quit diff --git a/tests/search-paths.scm b/tests/search-paths.scm new file mode 100644 index 0000000000..2a4c18dd76 --- /dev/null +++ b/tests/search-paths.scm @@ -0,0 +1,48 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-search-paths) + #:use-module (guix search-paths) + #:use-module (ice-9 match) + #:use-module (srfi srfi-64)) + +(define %top-srcdir + (dirname (search-path %load-path "guix.scm"))) + + +(test-begin "search-paths") + +(test-equal "evaluate-search-paths, separator is #f" + (string-append %top-srcdir + "/gnu/packages/bootstrap/armhf-linux") + + ;; The following search path spec should evaluate to a single item: the + ;; first directory that matches the "-linux$" pattern in + ;; gnu/packages/bootstrap. + (let ((spec (search-path-specification + (variable "CHBOUIB") + (files '("gnu/packages/bootstrap")) + (file-type 'directory) + (separator #f) + (file-pattern "-linux$")))) + (match (evaluate-search-paths (list spec) + (list %top-srcdir)) + (((spec* . value)) + (and (eq? spec* spec) value))))) + +(test-end "search-paths") |