ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 13:28:12 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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:
Ludovic Courtès 2015-01-20 10:17:24 +01:00
parent 6b1f9721a8
commit dbab5150f8
2 changed files with 27 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gnu/packages.scm
View file

@ -30,6 +30,8 @@ (define-module (gnu packages)
#: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 @@ (define %bootstrap-binaries-path
%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."

20
tests/packages.scm
View file

@ -42,6 +42,7 @@ (define-module (test-packages)
#: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 @@ (define read-at
(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)