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.

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"