mirror of
git://git.savannah.gnu.org/guix.git
synced 2023-12-14 03:33:07 +01:00
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.
This commit is contained in:
parent
6b1f9721a8
commit
dbab5150f8
2 changed files with 27 additions and 2 deletions
|
@ -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."
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue