[bug#49169] [PATCH v2 03/16] lint: Add 'input-labels' checker.

[Ludovic Courtès]

* 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.
---
 doc/guix.texi  |  6 ++++++
 guix/lint.scm  | 36 ++++++++++++++++++++++++++++++++++++
 tests/lint.scm | 14 ++++++++++++++
 3 files changed, 56 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 1659a2687a..0e5d1a9fa7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12153,6 +12153,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:
diff --git a/guix/lint.scm b/guix/lint.scm
index d65d5ce8f9..198e091f47 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -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
diff --git a/tests/lint.scm b/tests/lint.scm
index 6222c3b15a..0a8f1c6f54 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -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
-- 
2.32.0