lint: Lint usages of 'wrap-program' without a "bash" input.
When using 'wrap-program', "bash" (or "bash-minimal") should be in inputs. Otherwise, when cross-compiling, 'wrap-program' will use a native bash instead of the cross bash and the 'patch-shebangs' won't be able to correct this. Tobias Geerinckx-Rice is added to the copyright lines because a part of the "straw-viewer" package definition is included. This linter detects 365 problematic package definitions at time of writing. * guix/lint.scm (report-wrap-program-error): New procedure. (check-wrapper-inputs): New linter. (%local-checkers)[wrapper-inputs]: Add the new linter. ("explicit #:sh argument to 'wrap-program' is acceptable") ("'check-wrapper-inputs' detects 'wrap-program' without \"bash\" in inputs") ("'check-wrapper-inputs' detects 'wrap-qt-program' without \"bash\" in inputs") ("\"bash\" in 'inputs' satisfies 'check-wrapper-inputs'") ("\"bash-minimal\" in 'inputs' satisfies 'check-wrapper-inputs'") ("'cut' doesn't hide bad usages of 'wrap-program'") ("bogus phase specifications don't crash the linter"): New tests. Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>master
parent
a8e4c158f9
commit
eac82c0e0a
|
@ -81,6 +81,7 @@
|
||||||
#:export (check-description-style
|
#:export (check-description-style
|
||||||
check-inputs-should-be-native
|
check-inputs-should-be-native
|
||||||
check-inputs-should-not-be-an-input-at-all
|
check-inputs-should-not-be-an-input-at-all
|
||||||
|
check-wrapper-inputs
|
||||||
check-patch-file-names
|
check-patch-file-names
|
||||||
check-patch-headers
|
check-patch-headers
|
||||||
check-synopsis-style
|
check-synopsis-style
|
||||||
|
@ -491,6 +492,49 @@ of a package, and INPUT-NAMES, a list of package specifications such as
|
||||||
(package-input-intersection (package-direct-inputs package)
|
(package-input-intersection (package-direct-inputs package)
|
||||||
input-names))))
|
input-names))))
|
||||||
|
|
||||||
|
(define (report-wrap-program-error package wrapper-name)
|
||||||
|
"Warn that \"bash-minimal\" is missing from 'inputs', while WRAPPER-NAME
|
||||||
|
requires it."
|
||||||
|
(make-warning package
|
||||||
|
(G_ "\"bash-minimal\" should be in 'inputs' when '~a' is used")
|
||||||
|
(list wrapper-name)))
|
||||||
|
|
||||||
|
(define (check-wrapper-inputs package)
|
||||||
|
"Emit a warning if PACKAGE uses 'wrap-program' or similar, but \"bash\"
|
||||||
|
or \"bash-minimal\" is not in its inputs. 'wrap-script' is not supported."
|
||||||
|
(define input-names '("bash" "bash-minimal"))
|
||||||
|
(define has-bash-input?
|
||||||
|
(pair? (package-input-intersection (package-inputs package)
|
||||||
|
input-names)))
|
||||||
|
(define (check-procedure-body body)
|
||||||
|
(match body
|
||||||
|
;; Explicitely setting an interpreter is acceptable,
|
||||||
|
;; #:sh support is added on 'core-updates'.
|
||||||
|
;; TODO(core-updates): remove mention of core-updates.
|
||||||
|
(('wrap-program _ '#:sh . _) '())
|
||||||
|
(('wrap-program _ . _)
|
||||||
|
(list (report-wrap-program-error package 'wrap-program)))
|
||||||
|
;; Wrapper of 'wrap-program' for Qt programs.
|
||||||
|
;; TODO #:sh is not yet supported but probably will be.
|
||||||
|
(('wrap-qt-program _ '#:sh . _) '())
|
||||||
|
(('wrap-qt-program _ . _)
|
||||||
|
(list (report-wrap-program-error package 'wrap-qt-program)))
|
||||||
|
((x . y)
|
||||||
|
(append (check-procedure-body x) (check-procedure-body y)))
|
||||||
|
(_ '())))
|
||||||
|
(define (check-phase-procedure expression)
|
||||||
|
(find-procedure-body expression check-procedure-body))
|
||||||
|
(define (check-delta expression)
|
||||||
|
(find-phase-procedure package expression check-phase-procedure))
|
||||||
|
(define (check-deltas deltas)
|
||||||
|
(append-map check-delta deltas))
|
||||||
|
(if has-bash-input?
|
||||||
|
;; "bash" (or "bash-minimal") is in 'inputs', so everything seems ok.
|
||||||
|
'()
|
||||||
|
;; "bash" is not in 'inputs'. Verify 'wrap-program' and friends
|
||||||
|
;; are unused
|
||||||
|
(find-phase-deltas package check-deltas)))
|
||||||
|
|
||||||
(define (package-name-regexp package)
|
(define (package-name-regexp package)
|
||||||
"Return a regexp that matches PACKAGE's name as a word at the beginning of a
|
"Return a regexp that matches PACKAGE's name as a word at the beginning of a
|
||||||
line."
|
line."
|
||||||
|
@ -1696,6 +1740,10 @@ them for PACKAGE."
|
||||||
(name 'inputs-should-not-be-input)
|
(name 'inputs-should-not-be-input)
|
||||||
(description "Identify inputs that shouldn't be inputs at all")
|
(description "Identify inputs that shouldn't be inputs at all")
|
||||||
(check check-inputs-should-not-be-an-input-at-all))
|
(check check-inputs-should-not-be-an-input-at-all))
|
||||||
|
(lint-checker
|
||||||
|
(name 'wrapper-inputs)
|
||||||
|
(description "Make sure 'wrap-program' can finds its interpreter.")
|
||||||
|
(check check-wrapper-inputs))
|
||||||
(lint-checker
|
(lint-checker
|
||||||
(name 'license)
|
(name 'license)
|
||||||
;; TRANSLATORS: <license> is the name of a data type and must not be
|
;; TRANSLATORS: <license> is the name of a data type and must not be
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
|
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
|
||||||
;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
|
;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
|
||||||
;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
|
;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
|
||||||
|
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
|
||||||
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||||
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
|
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
|
||||||
;;;
|
;;;
|
||||||
|
@ -47,6 +48,7 @@
|
||||||
#:use-module (gnu packages glib)
|
#:use-module (gnu packages glib)
|
||||||
#:use-module (gnu packages pkg-config)
|
#:use-module (gnu packages pkg-config)
|
||||||
#:use-module (gnu packages python-xyz)
|
#:use-module (gnu packages python-xyz)
|
||||||
|
#:use-module ((gnu packages bash) #:select (bash bash-minimal))
|
||||||
#:use-module (web uri)
|
#:use-module (web uri)
|
||||||
#:use-module (web server)
|
#:use-module (web server)
|
||||||
#:use-module (web server http)
|
#:use-module (web server http)
|
||||||
|
@ -357,6 +359,92 @@
|
||||||
`(("python-setuptools" ,python-setuptools))))))
|
`(("python-setuptools" ,python-setuptools))))))
|
||||||
(check-inputs-should-not-be-an-input-at-all pkg))))
|
(check-inputs-should-not-be-an-input-at-all pkg))))
|
||||||
|
|
||||||
|
(test-equal "explicit #:sh argument to 'wrap-program' is acceptable"
|
||||||
|
'()
|
||||||
|
(let* ((phases
|
||||||
|
;; Loosely based on the "catfish" package
|
||||||
|
`(modify-phases %standard-phases
|
||||||
|
(add-after 'install 'wrap
|
||||||
|
(lambda* (#:key inputs outputs #:allow-other-keys)
|
||||||
|
(define catfish (string-append (assoc-ref outputs "out")
|
||||||
|
"/bin/catfish"))
|
||||||
|
(define hsab (string-append (assoc-ref inputs "hsab")
|
||||||
|
"/bin/hsab"))
|
||||||
|
(wrap-program catfish #:sh hsab
|
||||||
|
`("PYTHONPATH" = (,"blabla")))))))
|
||||||
|
(pkg (dummy-package "x" (arguments `(#:phases ,phases)))))
|
||||||
|
(check-wrapper-inputs pkg)))
|
||||||
|
|
||||||
|
(test-equal
|
||||||
|
"'check-wrapper-inputs' detects 'wrap-program' without \"bash\" in inputs"
|
||||||
|
"\"bash-minimal\" should be in 'inputs' when 'wrap-program' is used"
|
||||||
|
(let* ((phases
|
||||||
|
`(modify-phases %standard-phases
|
||||||
|
(add-after 'install 'wrap
|
||||||
|
(lambda _
|
||||||
|
(wrap-program the-binary bla-bla)))))
|
||||||
|
(pkg (dummy-package "x" (arguments `(#:phases ,phases)))))
|
||||||
|
(single-lint-warning-message (check-wrapper-inputs pkg))))
|
||||||
|
|
||||||
|
(test-equal
|
||||||
|
"'check-wrapper-inputs' detects 'wrap-qt-program' without \"bash\" in inputs"
|
||||||
|
"\"bash-minimal\" should be in 'inputs' when 'wrap-qt-program' is used"
|
||||||
|
(let* ((phases
|
||||||
|
`(modify-phases %standard-phases
|
||||||
|
(add-after 'install 'qtwrap
|
||||||
|
(lambda _
|
||||||
|
(wrap-qt-program the-binary bla-bla)))))
|
||||||
|
(pkg (dummy-package "x" (arguments `(#:phases ,phases)))))
|
||||||
|
(single-lint-warning-message (check-wrapper-inputs pkg))))
|
||||||
|
|
||||||
|
(test-equal "\"bash\" in 'inputs' satisfies 'check-wrapper-inputs'"
|
||||||
|
'()
|
||||||
|
(let* ((phases
|
||||||
|
`(modify-phases %standard-phases
|
||||||
|
(add-after 'install 'wrap
|
||||||
|
(lambda _
|
||||||
|
(wrap-program the-binary bla-bla)))))
|
||||||
|
(pkg (dummy-package "x" (arguments `(#:phases ,phases))
|
||||||
|
(inputs `(("bash" ,bash))))))
|
||||||
|
(check-wrapper-inputs pkg)))
|
||||||
|
|
||||||
|
(test-equal "\"bash-minimal\" in 'inputs' satisfies 'check-wrapper-inputs'"
|
||||||
|
'()
|
||||||
|
(let* ((phases
|
||||||
|
`(modify-phases %standard-phases
|
||||||
|
(add-after 'install 'wrap
|
||||||
|
(lambda _
|
||||||
|
(wrap-program THE-BINARY bla-bla)))))
|
||||||
|
(pkg (dummy-package "x" (arguments `(#:phases ,phases))
|
||||||
|
(inputs `(("bash-minimal" ,bash-minimal))))))
|
||||||
|
(check-wrapper-inputs pkg)))
|
||||||
|
|
||||||
|
(test-equal "'cut' doesn't hide bad usages of 'wrap-program'"
|
||||||
|
"\"bash-minimal\" should be in 'inputs' when 'wrap-program' is used"
|
||||||
|
(let* ((phases
|
||||||
|
;; Taken from the "straw-viewer" package
|
||||||
|
`(modify-phases %standard-phases
|
||||||
|
(add-after 'install 'wrap-program
|
||||||
|
(lambda* (#:key outputs #:allow-other-keys)
|
||||||
|
(let* ((out (assoc-ref outputs "out"))
|
||||||
|
(bin-dir (string-append out "/bin/"))
|
||||||
|
(site-dir (string-append out "/lib/perl5/site_perl/"))
|
||||||
|
(lib-path (getenv "PERL5LIB")))
|
||||||
|
(for-each (cut wrap-program <>
|
||||||
|
`("PERL5LIB" ":" prefix
|
||||||
|
(,lib-path ,site-dir)))
|
||||||
|
(find-files bin-dir)))))))
|
||||||
|
(pkg (dummy-package "x" (arguments `(#:phases ,phases)))))
|
||||||
|
(single-lint-warning-message (check-wrapper-inputs pkg))))
|
||||||
|
|
||||||
|
(test-equal "bogus phase specifications don't crash the linter"
|
||||||
|
"invalid phase clause"
|
||||||
|
(let* ((phases
|
||||||
|
`(modify-phases %standard-phases
|
||||||
|
(add-invalid)))
|
||||||
|
(pkg (dummy-package "x" (arguments `(#:phases ,phases)))))
|
||||||
|
(single-lint-warning-message (check-wrapper-inputs pkg))))
|
||||||
|
|
||||||
(test-equal "file patches: different file name -> warning"
|
(test-equal "file patches: different file name -> warning"
|
||||||
"file names of patches should start with the package name"
|
"file names of patches should start with the package name"
|
||||||
(single-lint-warning-message
|
(single-lint-warning-message
|
||||||
|
|
Reference in New Issue