[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/02: gnu: 'search-patch' raises an error when a patch is not found.
From: |
Ludovic Courtès |
Subject: |
02/02: gnu: 'search-patch' raises an error when a patch is not found. |
Date: |
Tue, 20 Jan 2015 09:17:54 +0000 |
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)