rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

lint: Report patches that cannot be found. 

* 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 @@
#: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 @@ warning for PACKAGE mentionning the FIELD."
'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 @@ descriptions maintained upstream."
(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 @@ requests."
(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