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:
		
							parent
							
								
									8524349f78
								
							
						
					
					
						commit
						b7f1b4c1d0
					
				
					 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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue