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

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit dbab5150f83543f0c8a424dfddb698d7812370b7
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jan 20 10:17:24 2015 +0100

    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.
---
 gnu/packages.scm   |    9 +++++++--
 tests/packages.scm |   20 ++++++++++++++++++++
 2 files changed, 27 insertions(+), 2 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 7f0b58b..263addb 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 bd5ba3e..ef34e76 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)