lint: 'patch-file-names' checks for file name length.
Reported at <https://bugs.gnu.org/27943> by Danny Milosavljevic <dannym@scratchpost.org>. * guix/scripts/lint.scm (%distro-directory): New variable. (check-patch-file-names): Add check for the file name length. * tests/lint.scm ("patches: file name too long"): New test.
This commit is contained in:
parent
1da3d2a3a1
commit
eef01cfe8e
|
@ -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."
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue