summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile.am3
-rw-r--r--gnu/packages/version-control.scm4
-rw-r--r--guix/build/profiles.scm24
-rw-r--r--guix/build/utils.scm13
-rw-r--r--guix/search-paths.scm28
-rw-r--r--tests/packages.scm49
-rw-r--r--tests/search-paths.scm48
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")
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-05 02:08:14 +0000