ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix: lint: Check for meaningful origin file names.

Browse source 
* 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:
Eric Bavier 2015-09-10 15:34:58 -05:00
parent 3b4d01035f
commit 50f5c46d06
3 changed files with 109 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
doc/guix.texi
View file

@ -4219,8 +4219,11 @@ Identify inputs that should most likely be native inputs.
@item source
@itemx home-page
@itemx source-file-name
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
Warn about obvious source code formatting issues: trailing white space,

27
guix/scripts/lint.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; 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>
;;;
;;; This file is part of GNU Guix.
@ -57,6 +57,7 @@ (define-module (guix scripts lint)
check-derivation
check-home-page
check-source
check-source-file-name
check-license
check-formatting
@ -501,6 +502,26 @@ (define (try-uris uris)
(display warning (guix-warning-port)))
(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)
"Emit a warning if we fail to compile PACKAGE to a derivation."
(catch #t
@ -642,6 +663,10 @@ (define %checkers
(name 'source)
(description "Validate source URLs")
(check check-source))
(lint-checker
(name 'source-file-name)
(description "Validate file names of sources")
(check check-source-file-name))
(lint-checker
(name 'derivation)
(description "Report failure to compile a package to a derivation")

80
tests/lint.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; 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>
;;;
;;; This file is part of GNU Guix.
@ -21,6 +21,7 @@
(define-module (test-lint)
#:use-module (guix tests)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix build-system gnu)
#:use-module (guix packages)
#:use-module (guix scripts lint)
@ -398,6 +399,83 @@ (define-syntax-rule (with-warnings body ...)
(check-home-page pkg))))
"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-equal "source: 200"
""