diff options
| -rw-r--r-- | guix/lint.scm | 48 | ||||
| -rw-r--r-- | tests/lint.scm | 88 |
2 files changed, 136 insertions, 0 deletions
diff --git a/guix/lint.scm b/guix/lint.scm index 5125b7722c..8f31de041d 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -81,6 +81,7 @@ #:export (check-description-style check-inputs-should-be-native check-inputs-should-not-be-an-input-at-all + check-wrapper-inputs check-patch-file-names check-patch-headers 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) 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) "Return a regexp that matches PACKAGE's name as a word at the beginning of a line." @@ -1697,6 +1741,10 @@ them for PACKAGE." (description "Identify inputs that shouldn't be inputs 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 (name 'license) ;; TRANSLATORS: <license> is the name of a data type and must not be ;; translated. diff --git a/tests/lint.scm b/tests/lint.scm index 4ef400a9a0..82971db8f0 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com> +;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; @@ -47,6 +48,7 @@ #:use-module (gnu packages glib) #:use-module (gnu packages pkg-config) #:use-module (gnu packages python-xyz) + #:use-module ((gnu packages bash) #:select (bash bash-minimal)) #:use-module (web uri) #:use-module (web server) #:use-module (web server http) @@ -357,6 +359,92 @@ `(("python-setuptools" ,python-setuptools)))))) (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" "file names of patches should start with the package name" (single-lint-warning-message |