gnu: 'search-patch' raises an error when a patch is not found.

* gnu/packages.scm (search-patch): Raise an error condition when
  'search-path' returns #f.
* tests/packages.scm ("patch not found yields a run-time error"): New
  test.

2 files changed, 27 insertions, 2 deletions

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 7f0b58b971a..263addb8beb 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -30,6 +30,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-39)
   #:export (search-patch
             search-bootstrap-binary
@@ -70,8 +72,11 @@
         %load-path)))
 
 (define (search-patch file-name)
-  "Search the patch FILE-NAME."
-  (search-path (%patch-path) file-name))
+  "Search the patch FILE-NAME.  Raise an error if not found."
+  (or (search-path (%patch-path) file-name)
+      (raise (condition
+              (&message (message (format #f (_ "~a: patch not found")
+                                         file-name)))))))
 
 (define (search-bootstrap-binary file-name system)
   "Search the bootstrap binary FILE-NAME for SYSTEM."
diff --git a/tests/packages.scm b/tests/packages.scm
index bd5ba3ee92c..ef34e763808 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -42,6 +42,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-64)
   #:use-module (rnrs io ports)
   #:use-module (ice-9 regex)
@@ -248,6 +249,25 @@
          (string=? (derivation->output-path drv)
                    (package-output %store package "out")))))
 
+(test-assert "patch not found yields a run-time error"
+  (guard (c ((condition-has-type? c &message)
+             (and (string-contains (condition-message c)
+                                   "does-not-exist.patch")
+                  (string-contains (condition-message c)
+                                   "not found"))))
+    (let ((p (package
+               (inherit (dummy-package "p"))
+               (source (origin
+                         (method (const #f))
+                         (uri "http://whatever")
+                         (patches
+                          (list (search-patch "does-not-exist.patch")))
+                         (sha256
+                          (base32
+                           "0amn0bbwqvsvvsh6drfwz20ydc2czk374lzw5kksbh6bf78k4ks4")))))))
+      (package-derivation %store p)
+      #f)))
+
 (test-assert "trivial"
   (let* ((p (package (inherit (dummy-package "trivial"))
               (build-system trivial-build-system)