me
/
guix
Archived
1
0
Fork 0

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
Maxime Devos 2021-07-01 12:59:52 +02:00 committed by Mathieu Othacehe
parent a8e4c158f9
commit eac82c0e0a
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
2 changed files with 136 additions and 0 deletions

View File

@ -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

View File

@ -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