diff options
| -rw-r--r-- | Makefile.am | 3 | ||||
| -rw-r--r-- | gnu/packages/version-control.scm | 4 | ||||
| -rw-r--r-- | guix/build/profiles.scm | 24 | ||||
| -rw-r--r-- | guix/build/utils.scm | 13 | ||||
| -rw-r--r-- | guix/search-paths.scm | 28 | ||||
| -rw-r--r-- | tests/packages.scm | 49 | ||||
| -rw-r--r-- | tests/search-paths.scm | 48 |
7 files changed, 144 insertions, 25 deletions
diff --git a/Makefile.am b/Makefile.am index 3e147df2e0..dd9069ea76 100644 --- a/Makefile.am +++ b/Makefile.am @@ -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> # Copyright © 2013 Andreas Enge <andreas@enge.fr> # Copyright © 2015 Alex Kost <alezost@gmail.com> # Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> @@ -272,6 +272,7 @@ SCM_TESTS = \ tests/nar.scm \ tests/union.scm \ tests/profiles.scm \ + tests/search-paths.scm \ tests/syscalls.scm \ tests/gremlin.scm \ tests/bournish.scm \ diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 7918b90ca6..bf1842010f 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org> @@ -297,10 +297,10 @@ as well as the classic centralized workflow.") (native-search-paths ;; For HTTPS access, Git needs a single-file certificate bundle, specified ;; with $GIT_SSL_CAINFO. - ;; FIXME: This variable designates a single file; it is not a search path. (list (search-path-specification (variable "GIT_SSL_CAINFO") (file-type 'regular) + (separator #f) ;single entry (files '("etc/ssl/certs/ca-certificates.crt"))))) (synopsis "Distributed version control system") diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm index 6e316d5d2c..42eabfaf19 100644 --- a/guix/build/profiles.scm +++ b/guix/build/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -39,17 +39,21 @@ 'GUIX_PROFILE' environment variable. This allows users to specify what the user-friendly name of the profile is, for instance ~/.guix-profile rather than /gnu/store/...-profile." - (let ((replacement (string-append "${GUIX_PROFILE:-" profile "}"))) + (let ((replacement (string-append "${GUIX_PROFILE:-" profile "}")) + (crop (cute string-drop <> (string-length profile)))) (match-lambda ((search-path . value) - (let* ((separator (search-path-specification-separator search-path)) - (items (string-tokenize* value separator)) - (crop (cute string-drop <> (string-length profile)))) - (cons search-path - (string-join (map (lambda (str) - (string-append replacement (crop str))) - items) - separator))))))) + (match (search-path-specification-separator search-path) + (#f + (cons search-path + (string-append replacement (crop value)))) + ((? string? separator) + (let ((items (string-tokenize* value separator))) + (cons search-path + (string-join (map (lambda (str) + (string-append replacement (crop str))) + items) + separator))))))))) (define (write-environment-variable-definition port) "Write the given environment variable definition to PORT." diff --git a/guix/build/utils.scm b/guix/build/utils.scm index bc6f114152..cf09326393 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.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> ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> @@ -400,10 +400,17 @@ for under the directories designated by FILES. For example: (delete-duplicates input-dirs))) (define (list->search-path-as-string lst separator) - (string-join lst separator)) + (if separator + (string-join lst separator) + (match lst + ((head rest ...) head) + (() "")))) (define* (search-path-as-string->list path #:optional (separator #\:)) - (string-tokenize path (char-set-complement (char-set separator)))) + (if separator + (string-tokenize path + (char-set-complement (char-set separator))) + (list path))) (define* (set-path-environment-variable env-var files input-dirs #:key diff --git a/guix/search-paths.scm b/guix/search-paths.scm index 7a6fe67959..4bf0e44389 100644 --- a/guix/search-paths.scm +++ b/guix/search-paths.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -55,7 +55,7 @@ search-path-specification? (variable search-path-specification-variable) ;string (files search-path-specification-files) ;list of strings - (separator search-path-specification-separator ;string + (separator search-path-specification-separator ;string | #f (default ":")) (file-type search-path-specification-file-type ;symbol (default 'directory)) @@ -131,11 +131,23 @@ like `string-tokenize', but SEPARATOR is a string." DIRECTORIES, a list of directory names, and return a list of specification/value pairs. Use GETENV to determine the current settings and report only settings not already effective." - (define search-path-definition - (match-lambda - ((and spec - ($ <search-path-specification> variable files separator - type pattern)) + (define (search-path-definition spec) + (match spec + (($ <search-path-specification> variable files #f type pattern) + ;; Separator is #f so return the first match. + (match (with-null-error-port + (search-path-as-list files directories + #:type type + #:pattern pattern)) + (() + #f) + ((head . _) + (let ((value (getenv variable))) + (if (and value (string=? value head)) + #f ;VARIABLE already set appropriately + (cons spec head)))))) + (($ <search-path-specification> variable files separator + type pattern) (let* ((values (or (and=> (getenv variable) (cut string-tokenize* <> separator)) '())) @@ -164,7 +176,7 @@ current value), or 'suffix (return the definition where VALUE is added as a suffix to VARIABLE's current value.) In the case of 'prefix and 'suffix, SEPARATOR is used as the separator between VARIABLE's current value and its prefix/suffix." - (match kind + (match (if (not separator) 'exact kind) ('exact (format #f "export ~a=\"~a\"" variable value)) ('prefix 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") |