guix: lint: Check for meaningful origin file names.
* guix/scripts/lint.scm (check-source-file-name): New procedure. (%checkers): Add 'source-file-name' checker. * tests/lint.scm ("source-file-name", "source-file-name: v prefix") ("source-file-name: valid", "source-file-name: bad checkout") ("source-file-name: good checkout"): New tests. * doc/guix.texi (Invoking guix lint): Mention file name check.
This commit is contained in:
parent
3b4d01035f
commit
50f5c46d06
|
@ -4219,8 +4219,11 @@ Identify inputs that should most likely be native inputs.
|
||||||
|
|
||||||
@item source
|
@item source
|
||||||
@itemx home-page
|
@itemx home-page
|
||||||
|
@itemx source-file-name
|
||||||
Probe @code{home-page} and @code{source} URLs and report those that are
|
Probe @code{home-page} and @code{source} URLs and report those that are
|
||||||
invalid.
|
invalid. Check that the source file name is meaningful, e.g. is not
|
||||||
|
just a version number or ``git-checkout'', and should not have a
|
||||||
|
@code{file-name} declared (@pxref{origin Reference}).
|
||||||
|
|
||||||
@item formatting
|
@item formatting
|
||||||
Warn about obvious source code formatting issues: trailing white space,
|
Warn about obvious source code formatting issues: trailing white space,
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
|
;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
|
||||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
|
||||||
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -57,6 +57,7 @@
|
||||||
check-derivation
|
check-derivation
|
||||||
check-home-page
|
check-home-page
|
||||||
check-source
|
check-source
|
||||||
|
check-source-file-name
|
||||||
check-license
|
check-license
|
||||||
check-formatting
|
check-formatting
|
||||||
|
|
||||||
|
@ -501,6 +502,26 @@ descriptions maintained upstream."
|
||||||
(display warning (guix-warning-port)))
|
(display warning (guix-warning-port)))
|
||||||
(reverse warnings)))))))))
|
(reverse warnings)))))))))
|
||||||
|
|
||||||
|
(define (check-source-file-name package)
|
||||||
|
"Emit a warning if PACKAGE's origin has no meaningful file name."
|
||||||
|
(define (origin-file-name-valid? origin)
|
||||||
|
;; Return #t if the source file name contains only a version or is #f;
|
||||||
|
;; indicates that the origin needs a 'file-name' field.
|
||||||
|
(let ((file-name (origin-actual-file-name origin))
|
||||||
|
(version (package-version package)))
|
||||||
|
(and file-name
|
||||||
|
(not (or (string-prefix? version file-name)
|
||||||
|
;; Common in many projects is for the filename to start
|
||||||
|
;; with a "v" followed by the version,
|
||||||
|
;; e.g. "v3.2.0.tar.gz".
|
||||||
|
(string-prefix? (string-append "v" version) file-name))))))
|
||||||
|
|
||||||
|
(let ((origin (package-source package)))
|
||||||
|
(unless (or (not origin) (origin-file-name-valid? origin))
|
||||||
|
(emit-warning package
|
||||||
|
(_ "the source file name should contain the package name")
|
||||||
|
'source))))
|
||||||
|
|
||||||
(define (check-derivation package)
|
(define (check-derivation package)
|
||||||
"Emit a warning if we fail to compile PACKAGE to a derivation."
|
"Emit a warning if we fail to compile PACKAGE to a derivation."
|
||||||
(catch #t
|
(catch #t
|
||||||
|
@ -642,6 +663,10 @@ or a list thereof")
|
||||||
(name 'source)
|
(name 'source)
|
||||||
(description "Validate source URLs")
|
(description "Validate source URLs")
|
||||||
(check check-source))
|
(check check-source))
|
||||||
|
(lint-checker
|
||||||
|
(name 'source-file-name)
|
||||||
|
(description "Validate file names of sources")
|
||||||
|
(check check-source-file-name))
|
||||||
(lint-checker
|
(lint-checker
|
||||||
(name 'derivation)
|
(name 'derivation)
|
||||||
(description "Report failure to compile a package to a derivation")
|
(description "Report failure to compile a package to a derivation")
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
|
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
|
||||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
|
||||||
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -21,6 +21,7 @@
|
||||||
(define-module (test-lint)
|
(define-module (test-lint)
|
||||||
#:use-module (guix tests)
|
#:use-module (guix tests)
|
||||||
#:use-module (guix download)
|
#:use-module (guix download)
|
||||||
|
#:use-module (guix git-download)
|
||||||
#:use-module (guix build-system gnu)
|
#:use-module (guix build-system gnu)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix scripts lint)
|
#:use-module (guix scripts lint)
|
||||||
|
@ -398,6 +399,83 @@ requests."
|
||||||
(check-home-page pkg))))
|
(check-home-page pkg))))
|
||||||
"not reachable: 404")))
|
"not reachable: 404")))
|
||||||
|
|
||||||
|
(test-assert "source-file-name"
|
||||||
|
(->bool
|
||||||
|
(string-contains
|
||||||
|
(with-warnings
|
||||||
|
(let ((pkg (dummy-package "x"
|
||||||
|
(version "3.2.1")
|
||||||
|
(source
|
||||||
|
(origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri "http://www.example.com/3.2.1.tar.gz")
|
||||||
|
(sha256 %null-sha256))))))
|
||||||
|
(check-source-file-name pkg)))
|
||||||
|
"file name should contain the package name")))
|
||||||
|
|
||||||
|
(test-assert "source-file-name: v prefix"
|
||||||
|
(->bool
|
||||||
|
(string-contains
|
||||||
|
(with-warnings
|
||||||
|
(let ((pkg (dummy-package "x"
|
||||||
|
(version "3.2.1")
|
||||||
|
(source
|
||||||
|
(origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri "http://www.example.com/v3.2.1.tar.gz")
|
||||||
|
(sha256 %null-sha256))))))
|
||||||
|
(check-source-file-name pkg)))
|
||||||
|
"file name should contain the package name")))
|
||||||
|
|
||||||
|
(test-assert "source-file-name: bad checkout"
|
||||||
|
(->bool
|
||||||
|
(string-contains
|
||||||
|
(with-warnings
|
||||||
|
(let ((pkg (dummy-package "x"
|
||||||
|
(version "3.2.1")
|
||||||
|
(source
|
||||||
|
(origin
|
||||||
|
(method git-fetch)
|
||||||
|
(uri (git-reference
|
||||||
|
(url "http://www.example.com/x.git")
|
||||||
|
(commit "0")))
|
||||||
|
(sha256 %null-sha256))))))
|
||||||
|
(check-source-file-name pkg)))
|
||||||
|
"file name should contain the package name")))
|
||||||
|
|
||||||
|
(test-assert "source-file-name: good checkout"
|
||||||
|
(not
|
||||||
|
(->bool
|
||||||
|
(string-contains
|
||||||
|
(with-warnings
|
||||||
|
(let ((pkg (dummy-package "x"
|
||||||
|
(version "3.2.1")
|
||||||
|
(source
|
||||||
|
(origin
|
||||||
|
(method git-fetch)
|
||||||
|
(uri (git-reference
|
||||||
|
(url "http://git.example.com/x.git")
|
||||||
|
(commit "0")))
|
||||||
|
(file-name (string-append "x-" version))
|
||||||
|
(sha256 %null-sha256))))))
|
||||||
|
(check-source-file-name pkg)))
|
||||||
|
"file name should contain the package name"))))
|
||||||
|
|
||||||
|
(test-assert "source-file-name: valid"
|
||||||
|
(not
|
||||||
|
(->bool
|
||||||
|
(string-contains
|
||||||
|
(with-warnings
|
||||||
|
(let ((pkg (dummy-package "x"
|
||||||
|
(version "3.2.1")
|
||||||
|
(source
|
||||||
|
(origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri "http://www.example.com/x-3.2.1.tar.gz")
|
||||||
|
(sha256 %null-sha256))))))
|
||||||
|
(check-source-file-name pkg)))
|
||||||
|
"file name should contain the package name"))))
|
||||||
|
|
||||||
(test-skip (if %http-server-socket 0 1))
|
(test-skip (if %http-server-socket 0 1))
|
||||||
(test-equal "source: 200"
|
(test-equal "source: 200"
|
||||||
""
|
""
|
||||||
|
|
Loading…
Reference in New Issue