diff options
| -rw-r--r-- | guix/scripts/lint.scm | 28 | ||||
| -rw-r--r-- | tests/lint.scm | 15 |
2 files changed, 39 insertions, 4 deletions
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 8840b1acb5..7300e55de2 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -587,24 +587,46 @@ from ~a") (package-home-page package)) 'home-page))))) +(define %distro-directory + (dirname (search-path %load-path "gnu.scm"))) + (define (check-patch-file-names package) "Emit a warning if the patches requires by PACKAGE are badly named or if the patch could not be found." (guard (c ((message-condition? c) ;raised by 'search-patch' (emit-warning package (condition-message c) 'patch-file-names))) + (define patches + (or (and=> (package-source package) origin-patches) + '())) + (unless (every (match-lambda ;patch starts with package name? ((? string? patch) (and=> (string-contains (basename patch) (package-name package)) zero?)) (_ #f)) ;must be an <origin> or something like that. - (or (and=> (package-source package) origin-patches) - '())) + patches) (emit-warning package (G_ "file names of patches should start with the package name") - 'patch-file-names)))) + 'patch-file-names)) + + ;; Check whether we're reaching tar's maximum file name length. + (let ((prefix (string-length %distro-directory)) + (margin (string-length "guix-0.13.0-10-123456789/")) + (max 99)) + (for-each (match-lambda + ((? string? patch) + (when (> (+ margin (- (string-length patch) prefix)) + max) + (emit-warning + package + (format #f (G_ "~a: file name is too long") + (basename patch)) + 'patch-file-names))) + (_ #f)) + patches)))) (define (escape-quotes str) "Replace any quote character in STR by an escaped quote character." diff --git a/tests/lint.scm b/tests/lint.scm index 1d0fc4708c..064f3d177e 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org> -;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2017 Alex Kost <alezost@gmail.com> @@ -331,6 +331,19 @@ (check-patch-file-names pkg))) "file names of patches should start with the package name"))) +(test-assert "patches: file name too long" + (->bool + (string-contains + (with-warnings + (let ((pkg (dummy-package "x" + (source + (dummy-origin + (patches (list (string-append "x-" + (make-string 100 #\a) + ".patch")))))))) + (check-patch-file-names pkg))) + "file name is too long"))) + (test-assert "patches: not found" (->bool (string-contains |