Subject: bug#25422: [PATCH 2/2] search-paths: Allow specs with #f as their separator.

From: Ludovic Courtès <[email-masked]>
Date: Sun, 22 Jan 2017 22:52:01 +0100

This adds support for single-entry search paths.
Fixes <http://bugs.gnu.org/25422>.
Reported by Leo Famulari <[email-masked]>.

* guix/search-paths.scm (<search-path-specification>)[separator]:
Document as string or #f.
* guix/search-paths.scm (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.
---
 Makefile.am                      |  3 ++-
 gnu/packages/version-control.scm |  4 ++--
 guix/build/profiles.scm          | 24 ++++++++++++--------
 guix/build/utils.scm             | 13 ++++++++---
 guix/search-paths.scm            | 28 ++++++++++++++++-------
 tests/packages.scm               | 49 +++++++++++++++++++++++++++++++++++++++-
 tests/search-paths.scm           | 48 +++++++++++++++++++++++++++++++++++++++
 7 files changed, 144 insertions(+), 25 deletions(-)
 create mode 100644 tests/search-paths.scm

diff --git a/Makefile.am b/Makefile.am
index 3e147df2e..dd9069ea7 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 <[email-masked]>
+# Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <[email-masked]>
 # Copyright © 2013 Andreas Enge <[email-masked]>
 # Copyright © 2015 Alex Kost <[email-masked]>
 # Copyright © 2016 Mathieu Lirzin <[email-masked]>
@@ -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 7918b90ca..bf1842010 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 <[email-masked]>
 ;;; Copyright © 2013 Cyril Roelandt <[email-masked]>
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <[email-masked]>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <[email-masked]>
 ;;; Copyright © 2013, 2014 Andreas Enge <[email-masked]>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <[email-masked]>
 ;;; Copyright © 2014, 2015, 2016 Mark H Weaver <[email-masked]>
@@ -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 6e316d5d2..42eabfaf1 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 <[email-masked]>
+;;; Copyright © 2015, 2017 Ludovic Courtès <[email-masked]>
 ;;;
 ;;; 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 bc6f11415..cf0932639 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 <[email-masked]>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <[email-masked]>
 ;;; Copyright © 2013 Andreas Enge <[email-masked]>
 ;;; Copyright © 2013 Nikita Karetnikov <[email-masked]>
 ;;; Copyright © 2015 Mark H Weaver <[email-masked]>
@@ -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 7a6fe6795..4bf0e4438 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 <[email-masked]>
+;;; Copyright © 2013, 2014, 2015, 2017 Ludovic Courtès <[email-masked]>
 ;;;
 ;;; 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 247f75cc4..962f120ea 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 <[email-masked]>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <[email-masked]>
 ;;;
 ;;; 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 000000000..2a4c18dd7
--- /dev/null
+++ b/tests/search-paths.scm
@@ -0,0 +1,48 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Ludovic Courtès <[email-masked]>
+;;;
+;;; 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")
-- 
2.11.0