nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

scripts: add guix lint 

* guix/scripts/lint.scm: New file. Defines a 'lint' tool for Guix packages.
* tests/lint.scm: New file.
* Makefile.am (MODULES, SCM_TESTS): Add them.
* po/guix/Makevars: Update appropriately.
* po/guix/POTFILES.in: Update appropriately.
* doc/guix.texi: Document "guix lint".
This commit is contained in:
Cyril Roelandt 2014-09-01 02:13:21 +02:00
parent 5e3b388b51
commit b4f5e0e87c
6 changed files with 357 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile.am
View File

@ -89,6 +89,7 @@ MODULES = \
guix/scripts/authenticate.scm \
guix/scripts/refresh.scm \
guix/scripts/system.scm \
guix/scripts/lint.scm \
guix.scm \
$(GNU_SYSTEM_MODULES)
@ -159,7 +160,8 @@ SCM_TESTS = \
tests/nar.scm \
tests/union.scm \
tests/profiles.scm \
tests/syscalls.scm
tests/syscalls.scm \
tests/lint.scm
SH_TESTS = \
tests/guix-build.sh \

29
doc/guix.texi
View File

@ -1459,7 +1459,10 @@ definitions like the one above may be automatically converted from the
Nixpkgs distribution using the @command{guix import} command.}, the
package may actually be built using the @code{guix build} command-line
tool (@pxref{Invoking guix build}). @xref{Packaging Guidelines}, for
more information on how to test package definitions.
more information on how to test package definitions, and
@ref{Invoking guix lint}, for information on how to check a definition
for style conformance.
Eventually, updating the package definition to a new upstream version
can be partly automated by the @command{guix refresh} command
@ -2328,6 +2331,7 @@ programming interface of Guix in a convenient way.
* Invoking guix download:: Downloading a file and printing its hash.
* Invoking guix hash:: Computing the cryptographic hash of a file.
* Invoking guix refresh:: Updating package definitions.
* Invoking guix lint:: Finding errors in package definitions.
@end menu
@node Invoking guix build
@ -2705,6 +2709,29 @@ for in @code{$PATH}.
@end table
@node Invoking guix lint
@section Invoking @command{guix lint}
The @command{guix lint} is meant to help package developers avoid common
errors and use a consistent style. It runs a few checks on a given set of
packages in order to find common mistakes in their definitions.
The general syntax is:
@example
guix lint @var{options} @var{package}@dots{}
@end example
If no package is given on the command line, then all packages are checked.
The @var{options} may be zero or more of the following:
@table @code
@item --list-checkers
@itemx -l
List and describe all the available checkers that will be run on packages
and exit.
@end table
@c *********************************************************************
@node GNU Distribution

213
guix/scripts/lint.scm Normal file
View File

@ -0,0 +1,213 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
(define-module (guix scripts lint)
#:use-module (guix base32)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (gnu packages)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-37)
#:export (guix-lint
check-inputs-should-be-native
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
;;;
(define* (emit-warning package message #:optional field)
;; Emit a warning about PACKAGE, printing the location of FIELD if it is
;; given, the location of PACKAGE otherwise, the full name of PACKAGE and the
;; provided MESSAGE.
(let ((loc (or (package-field-location package field)
(package-location package))))
(warning (_ "~a: ~a: ~a~%")
(location->string loc)
(package-full-name package)
message)))
;;;
;;; Checkers
;;;
(define-record-type* <lint-checker>
lint-checker make-lint-checker
lint-checker?
;; TODO: add a 'certainty' field that shows how confident we are in the
;; checker. Then allow users to only run checkers that have a certain
;; 'certainty' level.
(name lint-checker-name)
(description lint-checker-description)
(check lint-checker-check))
(define (list-checkers-and-exit)
;; Print information about all available checkers and exit.
(format #t (_ "Available checkers:~%"))
(for-each (lambda (checker)
(format #t "- ~a: ~a~%"
(lint-checker-name checker)
(lint-checker-description checker)))
%checkers)
(exit 0))
(define (check-inputs-should-be-native package)
;; Emit a warning if some inputs of PACKAGE are likely to belong to its
;; native inputs.
(let ((inputs (package-inputs package)))
(match inputs
(((labels packages . _) ...)
(when (member "pkg-config"
(map package-name (filter package? packages)))
(emit-warning package
"pkg-config should probably be a native input"
'inputs))))))
(define (check-synopsis-style package)
;; Emit a warning if stylistic issues are found in the synopsis of PACKAGE.
(define (check-final-period synopsis)
;; Synopsis should not end with a period, except for some special cases.
(if (and (string=? (string-take-right synopsis 1) ".")
(not (string=? (string-take-right synopsis 4) "etc.")))
(emit-warning package
"no period allowed at the end of the synopsis"
'synopsis)))
(define (check-start-article synopsis)
(if (or (string=? (string-take synopsis 2) "A ")
(string=? (string-take synopsis 3) "An "))
(emit-warning package
"no article allowed at the beginning of the synopsis"
'synopsis)))
(let ((synopsis (package-synopsis package)))
(if (string? synopsis)
(begin
(check-final-period synopsis)
(check-start-article synopsis)))))
(define (check-patches package)
;; Emit a warning if the patches requires by PACKAGE are badly named.
(let ((patches (and=> (package-source package) origin-patches))
(name (package-name package))
(full-name (package-full-name package)))
(if (and patches
(any (lambda (patch)
(let ((filename (basename patch)))
(not (or (eq? (string-contains filename name) 0)
(eq? (string-contains filename full-name) 0)))))
patches))
(emit-warning package
"file names of patches should start with the package name"
'patches))))
(define %checkers
(list
(lint-checker
(name "inputs-should-be-native")
(description "Identify inputs that should be native inputs")
(check check-inputs-should-be-native))
(lint-checker
(name "patch-filenames")
(description "Validate filenames of patches")
(check check-patches))
(lint-checker
(name "synopsis")
(description "Validate package synopsis")
(check check-synopsis-style))))
(define (run-checkers package)
;; Run all the checkers on PACKAGE.
(for-each (lambda (checker)
((lint-checker-check checker) package))
%checkers))
;;;
;;; Entry Point
;;;
(define (guix-lint . args)
(define (parse-options)
;; Return the alist of option values.
(args-fold* args %options
(lambda (opt name arg result)
(leave (_ "~A: unrecognized option~%") name))
(lambda (arg result)
(alist-cons 'argument arg result))
%default-options))
(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)))))

3
po/guix/Makevars
View File

@ -10,7 +10,8 @@ top_builddir = ../..
XGETTEXT_OPTIONS = \
--language=Scheme --from-code=UTF-8 \
--keyword=_ --keyword=N_ \
--keyword=message
--keyword=message \
--keyword=description
COPYRIGHT_HOLDER = Ludovic Courtès

1
po/guix/POTFILES.in
View File

@ -10,6 +10,7 @@ guix/scripts/pull.scm
guix/scripts/substitute-binary.scm
guix/scripts/authenticate.scm
guix/scripts/system.scm
guix/scripts/lint.scm
guix/gnu-maintenance.scm
guix/ui.scm
guix/http-client.scm

110
tests/lint.scm Normal file
View File

@ -0,0 +1,110 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
(define-module (test-packages)
#:use-module (guix build download)
#:use-module (guix build-system gnu)
#:use-module (guix packages)
#:use-module (guix scripts lint)
#:use-module (guix ui)
#:use-module (gnu packages)
#:use-module (gnu packages pkg-config)
#:use-module (srfi srfi-64))
;; Test the linter.
(test-begin "lint")
(define-syntax-rule (dummy-package name* extra-fields ...)
(package extra-fields ... (name name*) (version "0") (source #f)
(build-system gnu-build-system)
(synopsis #f) (description #f)
(home-page #f) (license #f) ))
(define (call-with-warnings thunk)
(let ((port (open-output-string)))
(parameterize ((guix-warning-port port))
(thunk))
(get-output-string port)))
(test-assert "synopsis: ends with a period"
(->bool
(string-contains (call-with-warnings
(lambda ()
(let ((pkg (dummy-package "x"
(synopsis "Bad synopsis."))))
(check-synopsis-style pkg))))
"no period allowed at the end of the synopsis")))
(test-assert "synopsis: ends with 'etc.'"
(->bool
(string-null? (call-with-warnings
(lambda ()
(let ((pkg (dummy-package "x"
(synopsis "Foo, bar, etc."))))
(check-synopsis-style pkg)))))))
(test-assert "synopsis: starts with 'A'"
(->bool
(string-contains (call-with-warnings
(lambda ()
(let ((pkg (dummy-package "x"
(synopsis "A bad synopŝis"))))
(check-synopsis-style pkg))))
"no article allowed at the beginning of the synopsis")))
(test-assert "synopsis: starts with 'An'"
(->bool
(string-contains (call-with-warnings
(lambda ()
(let ((pkg (dummy-package "x"
(synopsis "An awful synopsis"))))
(check-synopsis-style pkg))))
"no article allowed at the beginning of the synopsis")))
(test-assert "inputs: pkg-config is probably a native input"
(->bool
(string-contains
(call-with-warnings
(lambda ()
(let ((pkg (dummy-package "x"
(inputs `(("pkg-config" ,pkg-config))))))
(check-inputs-should-be-native pkg))))
"pkg-config should probably be a native input")))
(test-assert "patches: file names"
(->bool
(string-contains
(call-with-warnings
(lambda ()
(let ((pkg (dummy-package "x"
(source
(origin
(method url-fetch)
(uri "someurl")
(sha256 "somesha")
(patches (list "/path/to/y.patch")))))))
(check-patches pkg))))
"file names of patches should start with the package name")))
(test-end "lint")
(exit (= (test-runner-fail-count (test-runner-current)) 0))