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
 | 
					@item formatting
 | 
				
			||||||
Warn about obvious source code formatting issues: trailing white space,
 | 
					Warn about obvious source code formatting issues: trailing white space,
 | 
				
			||||||
use of tabulations, etc.
 | 
					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
 | 
					@end table
 | 
				
			||||||
 | 
					
 | 
				
			||||||
The general syntax is:
 | 
					The general syntax is:
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -79,6 +79,7 @@
 | 
				
			||||||
  #:export (check-description-style
 | 
					  #:export (check-description-style
 | 
				
			||||||
            check-inputs-should-be-native
 | 
					            check-inputs-should-be-native
 | 
				
			||||||
            check-inputs-should-not-be-an-input-at-all
 | 
					            check-inputs-should-not-be-an-input-at-all
 | 
				
			||||||
 | 
					            check-input-labels
 | 
				
			||||||
            check-patch-file-names
 | 
					            check-patch-file-names
 | 
				
			||||||
            check-patch-headers
 | 
					            check-patch-headers
 | 
				
			||||||
            check-synopsis-style
 | 
					            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)
 | 
					         (package-input-intersection (package-direct-inputs package)
 | 
				
			||||||
                                     input-names))))
 | 
					                                     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)
 | 
					(define (package-name-regexp package)
 | 
				
			||||||
  "Return a regexp that matches PACKAGE's name as a word at the beginning of a
 | 
					  "Return a regexp that matches PACKAGE's name as a word at the beginning of a
 | 
				
			||||||
line."
 | 
					line."
 | 
				
			||||||
| 
						 | 
					@ -1583,6 +1615,10 @@ them for PACKAGE."
 | 
				
			||||||
     (name        'inputs-should-not-be-input)
 | 
					     (name        'inputs-should-not-be-input)
 | 
				
			||||||
     (description "Identify inputs that shouldn't be inputs at all")
 | 
					     (description "Identify inputs that shouldn't be inputs at all")
 | 
				
			||||||
     (check       check-inputs-should-not-be-an-input-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
 | 
					   (lint-checker
 | 
				
			||||||
     (name        'license)
 | 
					     (name        'license)
 | 
				
			||||||
     ;; TRANSLATORS: <license> is the name of a data type and must not be
 | 
					     ;; TRANSLATORS: <license> is the name of a data type and must not be
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -356,6 +356,20 @@
 | 
				
			||||||
                              `(("python-setuptools" ,python-setuptools))))))
 | 
					                              `(("python-setuptools" ,python-setuptools))))))
 | 
				
			||||||
     (check-inputs-should-not-be-an-input-at-all pkg))))
 | 
					     (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"
 | 
					(test-equal "file patches: different file name -> warning"
 | 
				
			||||||
  "file names of patches should start with the package name"
 | 
					  "file names of patches should start with the package name"
 | 
				
			||||||
  (single-lint-warning-message
 | 
					  (single-lint-warning-message
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue