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

lint: Report patches that cannot be found.

Browse source 
* guix/scripts/lint.scm (check-patch-file-names): Wrap body in 'guard'.
* tests/lint.scm ("patches: not found"): New test.
This commit is contained in:
Ludovic Courtès 2015-04-10 10:27:26 +02:00
parent 56b1b74c90
commit b210b35d61
2 changed files with 40 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
guix/scripts/lint.scm
View file

@ -41,6 +41,8 @@ (define-module (guix scripts lint)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:export (guix-lint
check-description-style
@ -349,25 +351,29 @@ (define (check-home-page package)
'home-page)))))
(define (check-patch-file-names package)
;; Emit a warning if the patches requires by PACKAGE are badly named.
(let ((patches (and=> (package-source package) origin-patches))
(name (package-name package))
(full-name (package-full-name package)))
(when (and patches
(any (match-lambda
((? string? patch)
(let ((file (basename patch)))
(not (or (eq? (string-contains file name) 0)
(eq? (string-contains file full-name)
0)))))
(_
;; This must be an <origin> or something like that.
#f))
patches))
(emit-warning package
(_ "file names of patches should start with \
"Emit a warning if the patches requires by PACKAGE are badly named or if the
patch could not be found."
(guard (c ((message-condition? c) ;raised by 'search-patch'
(emit-warning package (condition-message c)
'patch-file-names)))
(let ((patches (and=> (package-source package) origin-patches))
(name (package-name package))
(full-name (package-full-name package)))
(when (and patches
(any (match-lambda
((? string? patch)
(let ((file (basename patch)))
(not (or (eq? (string-contains file name) 0)
(eq? (string-contains file full-name)
0)))))
(_
;; This must be an <origin> or something like that.
#f))
patches))
(emit-warning package
(_ "file names of patches should start with \
the package name")
'patch-file-names))))
'patch-file-names)))))
(define (escape-quotes str)
"Replace any quote character in STR by an escaped quote character."
@ -456,7 +462,7 @@ (define %checkers
(check check-inputs-should-be-native))
(lint-checker
(name 'patch-file-names)
(description "Validate file names of patches")
(description "Validate file names and availability of patches")
(check check-patch-file-names))
(lint-checker
(name 'home-page)

15
tests/lint.scm
View file

@ -304,6 +304,21 @@ (define-syntax-rule (with-warnings body ...)
(check-patch-file-names pkg)))
"file names of patches should start with the package name")))
(test-assert "patches: not found"
(->bool
(string-contains
(with-warnings
(let ((pkg (dummy-package "x"
(source
(origin
(method url-fetch)
(uri "someurl")
(sha256 "somesha")
(patches
(list (search-patch "this-patch-does-not-exist!"))))))))
(check-patch-file-names pkg)))
"patch not found")))
(test-assert "home-page: wrong home-page"
(->bool
(string-contains