civodul pushed a commit to branch wip-simplified-packages in repository guix.
commit 7c1ebdade6cdead4b1d92f5bee95298e358bc060 Author: Ludovic Courtès <[email protected]> AuthorDate: Thu May 20 16:17:00 2021 +0200 DRAFT lint: Add 'input-labels' checker. DRAFT: Good idea? If yes, add tests and doc. * guix/lint.scm (check-input-labels): New procedure. (%local-checkers): Add 'input-labels' checker. --- guix/lint.scm | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/guix/lint.scm b/guix/lint.scm index 1bebfe0..95f82db 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -383,6 +383,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." @@ -1494,6 +1525,10 @@ them for PACKAGE." (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 ;; translated.
