amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

lint: Add 'patch-headers' checker.

Browse source 
* guix/lint.scm (check-patch-headers): New procedure.
(%local-checkers): Add 'patch-headers' checker.
* tests/lint.scm ("patch headers: no warnings")
("patch headers: missing comment", "patch headers: empty")
("patch headers: patch not found"): New tests.
This commit is contained in:
Ludovic Courtès 2020-11-12 12:50:44 +01:00
parent e79ecff045
commit 4f156c259f
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 111 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

55
guix/lint.scm
View file

@ -35,6 +35,8 @@
#:use-module (guix http-client)
#:use-module (guix packages)
#:use-module (guix i18n)
#:use-module ((guix gexp)
#:select (local-file? local-file-absolute-file-name))
#:use-module (guix licenses)
#:use-module (guix records)
#:use-module (guix grafts)
@ -73,6 +75,7 @@
check-inputs-should-be-native
check-inputs-should-not-be-an-input-at-all
check-patch-file-names
check-patch-headers
check-synopsis-style
check-derivation
check-home-page
@ -712,6 +715,54 @@ patch could not be found."
(_ #f))
patches)))))
(define (check-patch-headers package)
"Check that PACKAGE's patches start with a comment. Return a list of
warnings."
(define (blank? str)
(string-every char-set:blank str))
(define (patch-header-warnings patch)
(call-with-input-file patch
(lambda (port)
;; Read from PORT until a non-blank line is found or EOF is reached.
(let loop ()
(let ((line (read-line port)))
(cond ((eof-object? line)
(list (make-warning package
(G_ "~a: empty patch")
(list (basename patch))
#:field 'source)))
((blank? line)
(loop))
((or (string-prefix? "--- " line)
(string-prefix? "+++ " line))
(list (make-warning package
(G_ "~a: patch lacks comment and \
upstream status")
(list (basename patch))
#:field 'source)))
(else
'())))))))
(guard (c ((formatted-message? c) ;raised by 'search-patch'
(list (%make-warning package
(formatted-message-string c)
(formatted-message-arguments c)
#:field 'source))))
(let ((patches (if (origin? (package-source package))
(origin-patches (package-source package))
'())))
(append-map (lambda (patch)
;; Dismiss PATCH if it's an origin or similar.
(cond ((string? patch)
(patch-header-warnings patch))
((local-file? patch)
(patch-header-warnings
(local-file-absolute-file-name patch)))
(else
'())))
patches))))
(define (escape-quotes str)
"Replace any quote character in STR by an escaped quote character."
(list->string
@ -1417,6 +1468,10 @@ or a list thereof")
(name 'patch-file-names)
(description "Validate file names and availability of patches")
(check check-patch-file-names))
(lint-checker
(name 'patch-headers)
(description "Validate patch headers")
(check check-patch-headers))
(lint-checker
(name 'formatting)
(description "Look for formatting issues in the source")