From f2b24f01f42c1bad3ddffd140194de1aec38a5f8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 20 Mar 2020 23:34:03 +0100
Subject: [PATCH] packages: 'package-field-location' preserves the original
file name.
Fixes <https://bugs.gnu.org/39425>.
Reported by Alex ter Weele <alex.ter.weele@gmail.com>.
* guix/packages.scm (package-field-location): Remove 'with-fluids' for
'%file-port-name-canonicalization'. Change the 'file' field of the
resulting location to FILE.
---
guix/packages.scm | 37 ++++++++++++++++++-------------------
1 file changed, 18 insertions(+), 19 deletions(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index 5ecb97f946e..4ab8650340f 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -355,25 +355,24 @@ (define (goto port line column)
(catch 'system-error
(lambda ()
;; 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))))))
+ (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)
+ (let ((props (source-properties value)))
+ (and props
+ ;; Preserve the original file name, which may be a
+ ;; relative file name.
+ (let ((loc (source-properties->location props)))
+ (set-field loc (location-file) file)))))
+ (_
+ #f))))
+ (_
+ #f)))))
(lambda _
#f)))
(_ #f)))
--
GitLab