diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-01-20 10:17:24 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-01-20 10:17:24 +0100 |
commit | dbab5150f83543f0c8a424dfddb698d7812370b7 (patch) | |
tree | 8e6e4194a1b734885eb60cc6a7075906519994e7 | |
parent | 6b1f9721a83f343315ae4b936ec9b9542ba8523e (diff) | |
download | guix-dbab5150f83543f0c8a424dfddb698d7812370b7.tar.gz |
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.
-rw-r--r-- | gnu/packages.scm | 9 | ||||
-rw-r--r-- | tests/packages.scm | 20 |
2 files changed, 27 insertions, 2 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm index 7f0b58b971..263addb8be 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 bd5ba3ee92..ef34e76380 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) |