[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/02: packages: 'package-field-location' preserves the original file na
From: |
guix-commits |
Subject: |
02/02: packages: 'package-field-location' preserves the original file name. |
Date: |
Fri, 20 Mar 2020 19:02:57 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit f2b24f01f42c1bad3ddffd140194de1aec38a5f8
Author: Ludovic Courtès <address@hidden>
AuthorDate: Fri Mar 20 23:34:03 2020 +0100
packages: 'package-field-location' preserves the original file name.
Fixes <https://bugs.gnu.org/39425>.
Reported by Alex ter Weele <address@hidden>.
* 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 5ecb97f..4ab8650 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -355,25 +355,24 @@ object."
(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)))