[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/05: packages: 'package-field-location' handles 'search-path' returnin
From: |
guix-commits |
Subject: |
01/05: packages: 'package-field-location' handles 'search-path' returning #f. |
Date: |
Mon, 22 Feb 2021 06:14:25 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit 9a38bed2cf32e9462badfa43e74cdd4580e804fc
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Feb 22 10:52:21 2021 +0100
packages: 'package-field-location' handles 'search-path' returning #f.
Fixes <https://bugs.gnu.org/46390>.
Reported by zimoun <zimon.toutoune@gmail.com>.
This is similar to the fix in d10474c38d58bdc676e64336769dc2e00cdfa8ed.
* guix/packages.scm (package-field-location): Handle FILE not in %LOAD-PATH.
* tests/guix-lint.sh: Add test.
---
guix/packages.scm | 51 ++++++++++++++++++++++++++++-----------------------
tests/guix-lint.sh | 5 +++++
2 files changed, 33 insertions(+), 23 deletions(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index 9305dab..57bc148 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -475,29 +475,34 @@ object."
(match (package-location package)
(($ <location> file line column)
- (catch 'system-error
- (lambda ()
- ;; In general we want to keep relative file names for modules.
- (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 ((loc (and=> (source-properties value)
- source-properties->location)))
- (and loc
- ;; Preserve the original file name, which may be a
- ;; relative file name.
- (set-field loc (location-file) file))))
- (_
- #f))))
- (_
- #f)))))
- (lambda _
- #f)))
+ (match (search-path %load-path file)
+ ((? string? file)
+ (catch 'system-error
+ (lambda ()
+ ;; In general we want to keep relative file names for modules.
+ (call-with-input-file file
+ (lambda (port)
+ (goto port line column)
+ (match (read port)
+ (('package inits ...)
+ (let ((field (assoc field inits)))
+ (match field
+ ((_ value)
+ (let ((loc (and=> (source-properties value)
+ source-properties->location)))
+ (and loc
+ ;; Preserve the original file name, which may
be a
+ ;; relative file name.
+ (set-field loc (location-file) file))))
+ (_
+ #f))))
+ (_
+ #f)))))
+ (lambda _
+ #f)))
+ (#f
+ ;; FILE could not be found in %LOAD-PATH.
+ #f)))
(_ #f)))
diff --git a/tests/guix-lint.sh b/tests/guix-lint.sh
index fdf548f..97c2ea8 100644
--- a/tests/guix-lint.sh
+++ b/tests/guix-lint.sh
@@ -90,3 +90,8 @@ guix lint -L $module_dir -c inputs-should-be-native dummy
dummy@42 dummy
# that it does find it anyway. See <https://bugs.gnu.org/42543>.
(cd "$module_dir"/.. ; guix lint -c formatting -L "$(basename "$module_dir")"
dummy@42) 2>&1 > "$module_dir/out"
test -z "$(cat "$module_dir/out")"
+
+# Likewise, when there's a warning, 'package-field-location' used to crash
+# because it can't find "t-xyz/foo.scm". See <https://bugs.gnu.org/46390>.
+(cd "$module_dir"/.. ; guix lint -c synopsis -L "$(basename "$module_dir")"
dummy@42) 2>&1 > "$module_dir/out"
+grep_warning "`cat "$module_dir/out"`"