aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi5
-rw-r--r--guix/scripts/lint.scm27
-rw-r--r--tests/lint.scm80
3 files changed, 109 insertions, 3 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 51f7cb24b9..b70be01faa 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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,
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 2a618c9451..ab7d7c67dc 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -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 @@
check-derivation
check-home-page
check-source
+ check-source-file-name
check-license
check-formatting
@@ -501,6 +502,26 @@ descriptions maintained upstream."
(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
@@ -643,6 +664,10 @@ or a list thereof")
(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")
(check check-derivation))
diff --git a/tests/lint.scm b/tests/lint.scm
index ac47dbb768..76040c1f3e 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -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 @@ requests."
(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"
""