diff options
| -rw-r--r-- | guix/scripts/lint.scm | 44 | ||||
| -rw-r--r-- | tests/lint.scm | 15 |
2 files changed, 40 insertions, 19 deletions
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 543b3dd1c5..699311a6a9 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -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) diff --git a/tests/lint.scm b/tests/lint.scm index 047f2786e0..ab89a58ae6 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -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 |