From 9a38bed2cf32e9462badfa43e74cdd4580e804fc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 22 Feb 2021 10:52:21 +0100
Subject: [PATCH] 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 9305dabcec..57bc148002 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -475,29 +475,34 @@ (define (goto port line column)
 
   (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 fdf548fbf1..97c2ea83fe 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"`"