[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] scripts: add guix lint
|
From: |
Cyril Roelandt |
|
Subject: |
[PATCH] scripts: add guix lint |
|
Date: |
Mon, 25 Aug 2014 03:52:44 +0200 |
* 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.
* guix/scripts/build.scm (specification->package): Move from here...
* guix/ui.scm: ... to here.
* po/guix/Makevars: Update appropriately.
* po/guix/POTFILES.in: Update appropriately.
* doc/guix.texi: Document "guix lint".
---
Makefile.am | 4 +-
doc/guix.texi | 27 +++++++
guix/scripts/build.scm | 21 -----
guix/scripts/lint.scm | 213 +++++++++++++++++++++++++++++++++++++++++++++++++
guix/ui.scm | 23 ++++++
po/guix/Makevars | 3 +-
po/guix/POTFILES.in | 1 +
tests/lint.scm | 110 +++++++++++++++++++++++++
8 files changed, 379 insertions(+), 23 deletions(-)
create mode 100644 guix/scripts/lint.scm
create mode 100644 tests/lint.scm
diff --git a/Makefile.am b/Makefile.am
index fff5958..371b85c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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 \
diff --git a/doc/guix.texi b/doc/guix.texi
index 09ed392..9a43543 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1459,6 +1459,10 @@ 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.
+In order to catch common errors and stylistic issues, the packages might
+actually be checked by running the @command{guix lint} command
+(@pxref{Invoking guix lint}).
+
Eventually, updating the package definition to a new upstream version
can be partly automated by the @command{guix refresh} command
(@pxref{Invoking guix refresh}).
@@ -2326,6 +2330,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
@@ -2703,6 +2708,28 @@ for in @code{$PATH}.
@end table
address@hidden Invoking guix lint
address@hidden Invoking @command{guix lint}
+The @command{guix lint} command runs a few checks on a given set of
+packages in order to find common mistakes in their definitions.
+
+The general syntax is:
+
address@hidden
+guix lint @var{options} @address@hidden
address@hidden 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:
+
address@hidden @code
+
address@hidden --list-checkers
address@hidden -l
+List and describe all the available checkers that will be run on packages
+and exit.
+
address@hidden table
@c *********************************************************************
@node GNU Distribution
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 5e4647d..b2682a1 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -41,27 +41,6 @@
guix-build))
-(define (specification->package spec)
- "Return a package matching SPEC. SPEC may be a package name, or a package
-name followed by a hyphen and a version number. If the version number is not
-present, return the preferred newest version."
- (let-values (((name version)
- (package-name->name+version spec)))
- (match (find-best-packages-by-name name version)
- ((p) ; one match
- p)
- ((p x ...) ; several matches
- (warning (_ "ambiguous package specification `~a'~%") spec)
- (warning (_ "choosing ~a from ~a~%")
- (package-full-name p)
- (location->string (package-location p)))
- p)
- (_ ; no matches
- (if version
- (leave (_ "~A: package not found for version ~a~%")
- name version)
- (leave (_ "~A: unknown package~%") name))))))
-
(define (register-root store paths root)
"Register ROOT as an indirect GC root for all of PATHS."
(let* ((root (string-append (canonicalize-path (dirname root))
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
new file mode 100644
index 0000000..e3b0697
--- /dev/null
+++ b/guix/scripts/lint.scm
@@ -0,0 +1,213 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 Cyril Roelandt <address@hidden>
+;;;
+;;; 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)))))
diff --git a/guix/ui.scm b/guix/ui.scm
index f11c2e9..86bd8f7 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -37,6 +37,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (ice-9 regex)
+ #:autoload (gnu packages) (find-best-packages-by-name)
#:export (_
N_
P_
@@ -64,6 +65,7 @@
program-name
guix-warning-port
warning
+ specification->package
guix-main))
;;; Commentary:
@@ -669,6 +671,27 @@ found."
(define guix-warning-port
(make-parameter (current-warning-port)))
+(define (specification->package spec)
+ "Return a package matching SPEC. SPEC may be a package name, or a package
+name followed by a hyphen and a version number. If the version number is not
+present, return the preferred newest version."
+ (let-values (((name version)
+ (package-name->name+version spec)))
+ (match (find-best-packages-by-name name version)
+ ((p) ; one match
+ p)
+ ((p x ...) ; several matches
+ (warning (_ "ambiguous package specification `~a'~%") spec)
+ (warning (_ "choosing ~a from ~a~%")
+ (package-full-name p)
+ (location->string (package-location p)))
+ p)
+ (_ ; no matches
+ (if version
+ (leave (_ "~A: package not found for version ~a~%")
+ name version)
+ (leave (_ "~A: unknown package~%") name))))))
+
(define (guix-main arg0 . args)
(initialize-guix)
(let ()
diff --git a/po/guix/Makevars b/po/guix/Makevars
index 87bb438..f5b498c 100644
--- a/po/guix/Makevars
+++ b/po/guix/Makevars
@@ -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
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index bf2d313..5cc68ff 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -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
diff --git a/tests/lint.scm b/tests/lint.scm
new file mode 100644
index 0000000..f6dae47
--- /dev/null
+++ b/tests/lint.scm
@@ -0,0 +1,110 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Cyril Roelandt <address@hidden>
+;;;
+;;; 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))
--
1.8.4.rc3
- [PATCH] scripts: add guix lint,
Cyril Roelandt <=