aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-11-18 23:56:07 +0100
committerLudovic Courtès <ludo@gnu.org>2013-11-18 23:56:07 +0100
commit0b8749b7bdd68c9b28cf3d520b9a3a9cc1a5bddb (patch)
treeb8d49b94aa148a63d3dbf320aeeff15364b9abdc
parentac5de156ae5de8cb61870469863fb862b6a1205e (diff)
downloadguix-0b8749b7bdd68c9b28cf3d520b9a3a9cc1a5bddb.tar
guix-0b8749b7bdd68c9b28cf3d520b9a3a9cc1a5bddb.tar.gz
packages: 'package-field-location' returns a relative file name.
* guix/packages.scm (package-field-location): Set %FILE-PORT-NAME-CANONICALIZATION. * tests/packages.scm ("package-field-location, relative file name"): New test.
-rw-r--r--guix/packages.scm38
-rw-r--r--tests/packages.scm6
2 files changed, 26 insertions, 18 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index b25cc52bba..bb7d873973 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -221,24 +221,26 @@ corresponds to the arguments expected by `set-path-environment-variable'."
(($ <location> file line column)
(catch 'system
(lambda ()
- (call-with-input-file (search-path %load-path file)
- (lambda (port)
- (goto port line column)
- (match (read port)
- (('package inits ...)
- (let ((field (assoc field inits)))
- (match field
- ((_ value)
- ;; Put the `or' here, and not in the first argument of
- ;; `and=>', to work around a compiler bug in 2.0.5.
- (or (and=> (source-properties value)
- source-properties->location)
- (and=> (source-properties field)
- source-properties->location)))
- (_
- #f))))
- (_
- #f)))))
+ ;; In general we want to keep relative file names for modules.
+ (with-fluids ((%file-port-name-canonicalization 'relative))
+ (call-with-input-file (search-path %load-path file)
+ (lambda (port)
+ (goto port line column)
+ (match (read port)
+ (('package inits ...)
+ (let ((field (assoc field inits)))
+ (match field
+ ((_ value)
+ ;; Put the `or' here, and not in the first argument of
+ ;; `and=>', to work around a compiler bug in 2.0.5.
+ (or (and=> (source-properties value)
+ source-properties->location)
+ (and=> (source-properties field)
+ source-properties->location)))
+ (_
+ #f))))
+ (_
+ #f))))))
(lambda _
#f)))
(_ #f)))
diff --git a/tests/packages.scm b/tests/packages.scm
index b499c380ce..7de3fc2156 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -81,6 +81,12 @@
(list version `(version ,version))))
(not (package-field-location %bootstrap-guile 'does-not-exist)))))
+;; Make sure we don't change the file name to an absolute file name.
+(test-equal "package-field-location, relative file name"
+ (location-file (package-location %bootstrap-guile))
+ (with-fluids ((%file-port-name-canonicalization 'absolute))
+ (location-file (package-field-location %bootstrap-guile 'version))))
+
(test-assert "package-transitive-inputs"
(let* ((a (dummy-package "a"))
(b (dummy-package "b"