From dd7c013d4be0fea8db61c909f5ba6f877c143fd3 Mon Sep 17 00:00:00 2001 From: Cyril Roelandt Date: Sun, 12 Oct 2014 01:58:29 +0200 Subject: guix lint: add the --checkers option. * guix/scripts/lint.scm: add the "--checkers" option. * doc/guix.texi (Invoking guix lint): Document it. * tests/guix-lint.sh: New file * Makefile.am (SCM_TESTS): Add it. --- Makefile.am | 3 +- doc/guix.texi | 5 +++ guix/scripts/lint.scm | 122 ++++++++++++++++++++++++++++---------------------- tests/guix-lint.sh | 75 +++++++++++++++++++++++++++++++ 4 files changed, 151 insertions(+), 54 deletions(-) create mode 100644 tests/guix-lint.sh diff --git a/Makefile.am b/Makefile.am index 4b823ec76c..b13fcbc053 100644 --- a/Makefile.am +++ b/Makefile.am @@ -186,7 +186,8 @@ SH_TESTS = \ tests/guix-package.sh \ tests/guix-system.sh \ tests/guix-archive.sh \ - tests/guix-authenticate.sh + tests/guix-authenticate.sh \ + tests/guix-lint.sh if BUILD_DAEMON diff --git a/doc/guix.texi b/doc/guix.texi index bbe84ab275..4c59d9f696 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2855,6 +2855,11 @@ The @var{options} may be zero or more of the following: @table @code +@item --checkers +@itemx -c +Only enable the checkers specified in a comma-separated list using the +names returned by @code{--list-checkers}. + @item --list-checkers @itemx -l List and describe all the available checkers that will be run on packages diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index fd9fd7b931..5c1ea360b7 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -34,44 +34,6 @@ (define-module (guix scripts lint) check-patches check-synopsis-style)) - -;;; -;;; Command-line options. -;;; - -(define %default-options - ;; Alist of default option values. - '()) - -(define (show-help) - (display (_ "Usage: guix lint [OPTION]... [PACKAGE]... -Run a set of checkers on the specified package; if none is specified, run the checkers on all packages.\n")) - (display (_ " - -h, --help display this help and exit")) - (display (_ " - -l, --list-checkers display the list of available lint checkers")) - (display (_ " - -V, --version display version information and exit")) - (newline) - (show-bug-report-information)) - -(define %options - ;; Specification of the command-line options. - ;; TODO: add some options: - ;; * --checkers=checker1,checker2...: only run the specified checkers - ;; * --certainty=[low,medium,high]: only run checkers that have at least this - ;; 'certainty'. - (list (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\l "list-checkers") #f #f - (lambda args - (list-checkers-and-exit))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix lint"))))) - ;;; ;;; Helpers @@ -223,11 +185,67 @@ (define %checkers (description "Validate package synopsis") (check check-synopsis-style)))) -(define (run-checkers package) - ;; Run all the checkers on PACKAGE. +(define (run-checkers package checkers) + ;; Run the given CHECKERS on PACKAGE. (for-each (lambda (checker) ((lint-checker-check checker) package)) - %checkers)) + checkers)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + ;; Alist of default option values. + '()) + +(define (show-help) + (display (_ "Usage: guix lint [OPTION]... [PACKAGE]... +Run a set of checkers on the specified package; if none is specified, run the checkers on all packages.\n")) + (display (_ " + -c, --checkers=CHECKER1,CHECKER2... + only run the specificed checkers")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -l, --list-checkers display the list of available lint checkers")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + + +(define %options + ;; Specification of the command-line options. + ;; TODO: add some options: + ;; * --certainty=[low,medium,high]: only run checkers that have at least this + ;; 'certainty'. + (list (option '(#\c "checkers") #t #f + (lambda (opt name arg result arg-handler) + (let ((names (string-split arg #\,))) + (for-each (lambda (c) + (when (not (member c (map lint-checker-name + %checkers))) + (leave (_ "~a: invalid checker") c))) + names) + (values (alist-cons 'checkers + (filter (lambda (checker) + (member (lint-checker-name checker) + names)) + %checkers) + result) + #f)))) + (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\l "list-checkers") #f #f + (lambda args + (list-checkers-and-exit))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix lint"))))) ;;; @@ -238,23 +256,21 @@ (define (guix-lint . args) (define (parse-options) ;; Return the alist of option values. (args-fold* args %options - (lambda (opt name arg result) + (lambda (opt name arg result arg-handler) (leave (_ "~A: unrecognized option~%") name)) - (lambda (arg result) + (lambda (arg result arg-handler) (alist-cons 'argument arg result)) - %default-options)) + %default-options #f)) (let* ((opts (parse-options)) (args (filter-map (match-lambda (('argument . value) value) (_ #f)) - (reverse opts)))) - - - (if (null? args) - (fold-packages (lambda (p r) (run-checkers p)) '()) - (for-each - (lambda (spec) - (run-checkers spec)) - (map specification->package args))))) + (reverse opts))) + (checkers (or (assoc-ref opts 'checkers) %checkers))) + (if (null? args) + (fold-packages (lambda (p r) (run-checkers p checkers)) '()) + (for-each (lambda (spec) + (run-checkers (specification->package spec) checkers)) + args)))) diff --git a/tests/guix-lint.sh b/tests/guix-lint.sh new file mode 100644 index 0000000000..5623d53ce5 --- /dev/null +++ b/tests/guix-lint.sh @@ -0,0 +1,75 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2014 Cyril Roelandt +# +# This file is part of GNU Guix. +# +# GNU Guix is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or (at +# your option) any later version. +# +# GNU Guix is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GNU Guix. If not, see . + +# +# Test the `guix lint' command-line utility. +# + +guix lint --version + +module_dir="t-guix-lint-$$" +mkdir "$module_dir" +trap "rm -rf $module_dir" EXIT + + +cat > "$module_dir/foo.scm"<&1` +if [ `grep_warning "$out"` -ne 3 ] +then false; else true; fi + +out=`guix lint -c synopsis dummy 2>&1` +if [ `grep_warning "$out"` -ne 2 ] +then false; else true; fi + +out=`guix lint -c description dummy 2>&1` +if [ `grep_warning "$out"` -ne 1 ] +then false; else true; fi + +out=`guix lint -c description,synopsis dummy 2>&1` +if [ `grep_warning "$out"` -ne 3 ] +then false; else true; fi + +if guix lint -c synopsis,invalid-checker dummy 2>&1 | \ + grep -q 'invalid-checker: invalid checker' +then true; else false; fi -- cgit v1.2.3