lint: Add 'input-labels' checker.

* guix/lint.scm (check-input-labels): New procedure.
(%local-checkers): Add 'input-labels' checker.
* tests/lint.scm ("input labels: no warnings")
("input labels: one warning"): New tests.
* doc/guix.texi (Invoking guix lint): Mention it.
This commit is contained in:
Ludovic Courtès 2021-05-20 16:17:00 +02:00
parent 8524349f78
commit b7f1b4c1d0
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 56 additions and 0 deletions

@ -12158,6 +12158,12 @@ declare them as in this example:
@item formatting
Warn about obvious source code formatting issues: trailing white space,
use of tabulations, etc.
@item input-labels
Report old-style input labels that do not match the name of the
corresponding package. This aims to help migrate from the ``old input
style''. @xref{package Reference}, for more information on package
inputs and input styles.
@end table
The general syntax is:

@ -79,6 +79,7 @@
#:export (check-description-style
check-inputs-should-be-native
check-inputs-should-not-be-an-input-at-all
check-input-labels
check-patch-file-names
check-patch-headers
check-synopsis-style
@ -416,6 +417,37 @@ of a package, and INPUT-NAMES, a list of package specifications such as
(package-input-intersection (package-direct-inputs package)
input-names))))
(define (check-input-labels package)
"Emit a warning for labels that differ from the corresponding package name."
(define (check input-kind package-inputs)
(define (warning label name)
(make-warning package
(G_ "label '~a' does not match package name '~a'")
(list label name)
#:field input-kind))
(append-map (match-lambda
(((? string? label) (? package? dependency))
(if (string=? label (package-name dependency))
'()
(list (warning label (package-name dependency)))))
(((? string? label) (? package? dependency) output)
(let ((expected (string-append (package-name dependency)
":" output)))
(if (string=? label expected)
'()
(list (warning label expected)))))
(_
'()))
(package-inputs package)))
(append-map (match-lambda
((kind proc)
(check kind proc)))
`((native-inputs ,package-native-inputs)
(inputs ,package-inputs)
(propagated-inputs ,package-propagated-inputs))))
(define (package-name-regexp package)
"Return a regexp that matches PACKAGE's name as a word at the beginning of a
line."
@ -1583,6 +1615,10 @@ them for PACKAGE."
(name 'inputs-should-not-be-input)
(description "Identify inputs that shouldn't be inputs at all")
(check check-inputs-should-not-be-an-input-at-all))
(lint-checker
(name 'input-labels)
(description "Identify input labels that do not match package names")
(check check-input-labels))
(lint-checker
(name 'license)
;; TRANSLATORS: <license> is the name of a data type and must not be

@ -356,6 +356,20 @@
`(("python-setuptools" ,python-setuptools))))))
(check-inputs-should-not-be-an-input-at-all pkg))))
(test-assert "input labels: no warnings"
(let ((pkg (dummy-package "x"
(inputs `(("glib" ,glib)
("pkg-config" ,pkg-config))))))
(null? (check-input-labels pkg))))
(test-equal "input labels: one warning"
"label 'pkgkonfig' does not match package name 'pkg-config'"
(single-lint-warning-message
(let ((pkg (dummy-package "x"
(inputs `(("glib" ,glib)
("pkgkonfig" ,pkg-config))))))
(check-input-labels pkg))))
(test-equal "file patches: different file name -> warning"
"file names of patches should start with the package name"
(single-lint-warning-message