summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-01-03 19:46:07 +0100
committerLudovic Courtès <ludo@gnu.org>2015-01-03 19:46:07 +0100
commitcf81a2363989429f4af518e92e7404655d45dbc7 (patch)
tree9f1ea0289f3d55aca2d127637c19b79b4346689a
parent7452806931216a5ec8712dd39327540a3307a6ce (diff)
guix package: Follow symlinks for pattern search paths.
* guix/scripts/package.scm (search-path-environment-variables): Add local 'files' variable. * tests/packages.scm ("--search-paths with pattern"): New test.
-rw-r--r--guix/scripts/package.scm17
-rw-r--r--tests/packages.scm51
2 files changed, 62 insertions, 6 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 2f694cd55f..30b0658198 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -365,12 +365,17 @@ current settings and report only settings not already effective."
(match-lambda
(($ <search-path-specification> variable files separator
type pattern)
- (let ((values (or (and=> (getenv variable)
- (cut string-tokenize* <> separator))
- '()))
- (path (search-path-as-list files (list profile)
- #:type type
- #:pattern pattern)))
+ (let* ((values (or (and=> (getenv variable)
+ (cut string-tokenize* <> separator))
+ '()))
+ ;; Add a trailing slash to force symlinks to be treated as
+ ;; directories when 'find-files' traverses them.
+ (files (if pattern
+ (map (cut string-append <> "/") files)
+ files))
+ (path (search-path-as-list files (list profile)
+ #:type type
+ #:pattern pattern)))
(if (every (cut member <> values) path)
#f
(format #f "export ~a=\"~a\""
diff --git a/tests/packages.scm b/tests/packages.scm
index bb83032602..72c69ff653 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -19,6 +19,7 @@
(define-module (test-packages)
#:use-module (guix tests)
#:use-module (guix store)
+ #:use-module (guix monads)
#:use-module ((guix utils)
;; Rename the 'location' binding to allow proper syntax
;; matching when setting the 'location' field of a package.
@@ -31,10 +32,13 @@
#:use-module (guix build-system)
#:use-module (guix build-system trivial)
#:use-module (guix build-system gnu)
+ #:use-module (guix profiles)
+ #:use-module (guix scripts package)
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu packages guile)
#:use-module (gnu packages bootstrap)
+ #:use-module (gnu packages xml)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
@@ -527,6 +531,53 @@
(((? (cut eq? hello <>))) #t)
(wrong (pk 'find-packages-by-name wrong #f))))
+(test-assert "--search-paths with pattern"
+ ;; Make sure 'guix package --search-paths' correctly reports environment
+ ;; variables when file patterns are used (in particular, it must follow
+ ;; symlinks when looking for 'catalog.xml'.) To do that, we rely on the
+ ;; libxml2 package specification, which contains such a definition.
+ (let* ((p1 (package
+ (name "foo") (version "0") (source #f)
+ (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 "/xml/bar/baz"))
+ (call-with-output-file
+ (string-append out "/xml/bar/baz/catalog.xml")
+ (lambda (port)
+ (display "xml? wat?!" port)))))))
+ (synopsis #f) (description #f)
+ (home-page #f) (license #f)))
+ (p2 (package
+ ;; Provide a fake libxml2 to avoid building the real one. This
+ ;; is OK because 'guix package' gets search path specifications
+ ;; from the same-named package found in the distro.
+ (name "libxml2") (version "0.0.0") (source #f)
+ (build-system trivial-build-system)
+ (arguments
+ `(#:guile ,%bootstrap-guile
+ #:builder (mkdir (assoc-ref %outputs "out"))))
+ (native-search-paths (package-native-search-paths libxml2))
+ (synopsis #f) (description #f)
+ (home-page #f) (license #f)))
+ (prof (run-with-store %store
+ (profile-derivation
+ (manifest (map package->manifest-entry
+ (list p1 p2)))
+ #:info-dir? #f)
+ #:guile-for-build (%guile-for-build))))
+ (build-derivations %store (list prof))
+ (string-match (format #f "^export XML_CATALOG_FILES=\"~a/xml/+bar/baz/catalog\\.xml\"\n"
+ (derivation->output-path prof))
+ (with-output-to-string
+ (lambda ()
+ (guix-package "-p" (derivation->output-path prof)
+ "--search-paths"))))))
+
(test-end "packages")