From: Eric Bavier <[email protected]> * guix/scripts/lint.scm (check-source): Emit warning if source filename contains only the version of the package. --- guix/scripts/lint.scm | 64 +++++++++++++++++++++++++++++++-------------------- 1 file changed, 39 insertions(+), 25 deletions(-)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 14ac8cb..c0300bc 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 <[email protected]> -;;; Copyright © 2014 Eric Bavier <[email protected]> +;;; Copyright © 2014, 2015 Eric Bavier <[email protected]> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <[email protected]> ;;; ;;; This file is part of GNU Guix. @@ -20,6 +20,7 @@ (define-module (guix scripts lint) #:use-module (guix store) + #:use-module (guix derivations) #:use-module (guix base32) #:use-module (guix download) #:use-module (guix ftp-client) @@ -466,31 +467,44 @@ descriptions maintained upstream." uris)) '())) + (define (origin-version-name? origin) + ;; Return #t if the source file name contains only a version; indicates + ;; that the origin needs a 'file-name' field. + (string-prefix? (package-version package) + (store-path-package-name + (with-store store + (derivation->output-path + (package-source-derivation store origin)))))) + (let ((origin (package-source package))) - (when (and origin - (eqv? (origin-method origin) url-fetch)) - (let* ((strings (origin-uri origin)) - (uris (if (list? strings) - (map string->uri strings) - (list (string->uri strings))))) - - ;; Just make sure that at least one of the URIs is valid. - (call-with-values - (lambda () (try-uris uris)) - (lambda (success? warnings) - ;; When everything fails, report all of WARNINGS, otherwise don't - ;; report anything. - ;; - ;; XXX: Ideally we'd still allow warnings to be raised if *some* - ;; URIs are unreachable, but distinguish that from the error case - ;; where *all* the URIs are unreachable. - (unless success? - (emit-warning package - (_ "all the source URIs are unreachable:") - 'source) - (for-each (lambda (warning) - (display warning (guix-warning-port))) - (reverse warnings))))))))) + (when origin + (if (eqv? (origin-method origin) url-fetch) + (let* ((strings (origin-uri origin)) + (uris (if (list? strings) + (map string->uri strings) + (list (string->uri strings))))) + + ;; Just make sure that at least one of the URIs is valid. + (call-with-values + (lambda () (try-uris uris)) + (lambda (success? warnings) + ;; When everything fails, report all of WARNINGS, otherwise don't + ;; report anything. + ;; + ;; XXX: Ideally we'd still allow warnings to be raised if *some* + ;; URIs are unreachable, but distinguish that from the error case + ;; where *all* the URIs are unreachable. + (unless success? + (emit-warning package + (_ "all the source URIs are unreachable:") + 'source) + (for-each (lambda (warning) + (display warning (guix-warning-port))) + (reverse warnings))))))) + (if (origin-version-name? origin) + (emit-warning package + (_ "the source filename should contain the package name") + 'source))))) (define (check-derivation package) "Emit a warning if we fail to compile PACKAGE to a derivation." -- 2.4.3
