* [bug#48320] [PATCH] lint: Verify if #:tests? is respected in the 'check' phase. @ 2021-05-09 18:02 Maxime Devos 2021-06-18 12:15 ` Mathieu Othacehe 2021-06-28 21:15 ` [bug#48320] [PATCH v2] " Maxime Devos 0 siblings, 2 replies; 7+ messages in thread From: Maxime Devos @ 2021-05-09 18:02 UTC (permalink / raw) To: 48320 [-- Attachment #1.1: Type: text/plain, Size: 325 bytes --] Hi guix, There have been a few patches to the mailing list lately not respecting this, and this linter detects 325 package definitions that could be modified to support the --without-tests package transformation. Copyright lines were added in the previous patch I sent to guix-patches today. Greetings, Maxime [-- Attachment #1.2: 0001-lint-Verify-if-tests-is-respected-in-the-check-phase.patch --] [-- Type: text/x-patch, Size: 5061 bytes --] From 77f6fdb0158d76af9a6789bd0da45ac852ee2868 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Sun, 9 May 2021 19:53:31 +0200 Subject: [PATCH] lint: Verify if #:tests? is respected in the 'check' phase. There have been a few patches to the mailing list lately not respecting this, and this linter detects 325 package definitions that could be modified to support the --without-tests package transformation. * guix/lint.scm (check-optional-tests): New linter. (%local-checkers)[optional-tests]: Add it. * tests/lint.scm (package-with-phase-changes): New procedure. ("optional-tests: no check phase") ("optional-tests: check phase respects #:tests?") ("optional-tests: check phase ignores #:tests?") ("optional-tests: do not crash when #:phases is invalid"): New tests. --- guix/lint.scm | 40 ++++++++++++++++++++++++++++++++++++++++ tests/lint.scm | 31 +++++++++++++++++++++++++++++++ 2 files changed, 71 insertions(+) diff --git a/guix/lint.scm b/guix/lint.scm index d1cbc9d300..f5db4664dc 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -87,6 +87,7 @@ check-source check-source-file-name check-source-unstable-tarball + check-optional-tests check-mirror-url check-github-url check-license @@ -963,6 +964,41 @@ descriptions maintained upstream." (origin-uris origin)) '()))) +(define (check-optional-tests package) + "Emit a warning if the test suite is run unconditionally." + (define (check-check-procedure expression) + (match expression + (`(,(or 'lambda 'lambda*) ,_ (invoke . ,_) . ,_) + (list (make-warning package + ;; TRANSLATORS: check and #:tests? are a Scheme + ;; symbol and keyword respectively and should not + ;; be translated. + (G_ "the 'check' phase should respect #:tests?") + #:field 'arguments))) + ;; The 'check' phase seems ok, stop searching for a bug in this package + ;; definition. + (_ '()))) + (define (check-phases-delta delta) + (match delta + (`(replace 'check ,expression) + (check-check-procedure expression)) + (_ #f))) + (define (check-phases-deltas deltas) + (match deltas + (() '()) + ((head . tail) + (or (check-phases-delta head) + (check-phases-deltas tail))) + (_ (list (make-warning package + (G_ "incorrect call to modify-phases") + #:field 'arguments))))) + (apply (lambda* (#:key phases #:allow-other-keys) + (match phases + (`(modify-phases ,_ . ,changes) + (check-phases-deltas changes)) + (_ '()))) + (package-arguments package))) + (define (check-mirror-url package) "Check whether PACKAGE uses source URLs that should be 'mirror://'." (define (check-mirror-uri uri) ;XXX: could be optimized @@ -1529,6 +1565,10 @@ them for PACKAGE." (description "Make sure the 'license' field is a <license> \ or a list thereof") (check check-license)) + (lint-checker + (name 'optional-tests) + (description "Make sure tests are only run when requested") + (check check-optional-tests)) (lint-checker (name 'mirror-url) (description "Suggest 'mirror://' URLs") diff --git a/tests/lint.scm b/tests/lint.scm index d6e877d0d7..c9cd6366ec 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -731,6 +731,37 @@ (sha256 %null-sha256)))))) (check-source-unstable-tarball pkg))) +(define (package-with-phase-changes changes) + (dummy-package "x" + (arguments `(#:phases + (modify-phases %standard-phases ,@changes))))) + +(test-equal "optional-tests: no check phase" + '() + (let ((pkg (package-with-phase-changes '()))) + (check-optional-tests pkg))) +(test-equal "optional-tests: check phase respects #:tests?" + '() + (let ((pkg (package-with-phase-changes + '((replace 'check + (lambda (#:key tests? #:allow-other-keys?) + (when tests? + (invoke "./the-test-suite")))))))) + (check-optional-tests pkg))) +(test-equal "optional-tests: check phase ignores #:tests?" + "the 'check' phase should respect #:tests?" + (let ((pkg (package-with-phase-changes + '((replace 'check + (lambda _ + (invoke "./the-test-suite"))))))) + (single-lint-warning-message + (check-optional-tests pkg)))) +(test-equal "optional-tests: do not crash when #:phases is invalid" + "incorrect call to modify-phases" + (let ((pkg (package-with-phase-changes 'this-is-not-a-list))) + (single-lint-warning-message + (check-optional-tests pkg)))) + (test-equal "source: 200" '() (with-http-server `((200 ,%long-string)) -- 2.31.1 [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 260 bytes --] ^ permalink raw reply related [flat|nested] 7+ messages in thread
* [bug#48320] [PATCH] lint: Verify if #:tests? is respected in the 'check' phase. 2021-05-09 18:02 [bug#48320] [PATCH] lint: Verify if #:tests? is respected in the 'check' phase Maxime Devos @ 2021-06-18 12:15 ` Mathieu Othacehe 2021-06-18 15:34 ` Maxime Devos 2021-06-28 21:15 ` [bug#48320] [PATCH v2] " Maxime Devos 1 sibling, 1 reply; 7+ messages in thread From: Mathieu Othacehe @ 2021-06-18 12:15 UTC (permalink / raw) To: Maxime Devos; +Cc: 48320 Hello Maxime, > + (`(,(or 'lambda 'lambda*) ,_ (invoke . ,_) . ,_) > + (list (make-warning package > + ;; TRANSLATORS: check and #:tests? are a Scheme > + ;; symbol and keyword respectively and should not > + ;; be translated. > + (G_ "the 'check' phase should respect #:tests?") > + #:field 'arguments))) I like the idea behind this patch. However I think the detection pattern could be improved for instance, here are a few unreported packages: - dejagnu - python-dateutil - eigen Maybe we should check directly if the tests? variable is used within the 'check replace phase? Thanks, Mathieu ^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#48320] [PATCH] lint: Verify if #:tests? is respected in the 'check' phase. 2021-06-18 12:15 ` Mathieu Othacehe @ 2021-06-18 15:34 ` Maxime Devos 0 siblings, 0 replies; 7+ messages in thread From: Maxime Devos @ 2021-06-18 15:34 UTC (permalink / raw) To: Mathieu Othacehe; +Cc: 48320 [-- Attachment #1: Type: text/plain, Size: 1673 bytes --] Mathieu Othacehe schreef op vr 18-06-2021 om 14:15 [+0200]: > Hello Maxime, > > > + (`(,(or 'lambda 'lambda*) ,_ (invoke . ,_) . ,_) > > + (list (make-warning package > > + ;; TRANSLATORS: check and #:tests? are a Scheme > > + ;; symbol and keyword respectively and should not > > + ;; be translated. > > + (G_ "the 'check' phase should respect #:tests?") > > + #:field 'arguments))) I just noticed the following test case in (tests lint) is somewhat bogus: > + '((replace 'check+ > + (lambda (#:key tests? #:allow-other-keys?) Instead of 'lambda', this should be 'lambda*'. Also, the value for #:phases can now be a G-expression, so the usage of 'package-arguments' in the patch would need to be adjusted as well. > I like the idea behind this patch. However I think the detection pattern > could be improved for instance, here are a few unreported packages: > > - dejagnu > - python-dateutil > - eigen > > Maybe we should check directly if the tests? variable is used within the > 'check replace phase? So, basically, test if applying the following procedure to the body succeeds? (define (sexp-uses-tests?? sexp) (sexp-contains-atom? sexp 'tests?)) (define (sexp-contains-atom? sexp atom) ; atoms are compared with eq? and vectors are currently not supported (if (pair? sexp) (or (sexp-contains? sexp atom) (sexp-contains? sexp atom)) (eq? sexp atom))) That seems a good improvement for a v2. Thanks, Maxime. [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 260 bytes --] ^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#48320] [PATCH v2] lint: Verify if #:tests? is respected in the 'check' phase. 2021-05-09 18:02 [bug#48320] [PATCH] lint: Verify if #:tests? is respected in the 'check' phase Maxime Devos 2021-06-18 12:15 ` Mathieu Othacehe @ 2021-06-28 21:15 ` Maxime Devos 2021-06-29 10:34 ` Mathieu Othacehe 1 sibling, 1 reply; 7+ messages in thread From: Maxime Devos @ 2021-06-28 21:15 UTC (permalink / raw) To: 48320; +Cc: Mathieu Othacehe [-- Attachment #1.1: Type: text/plain, Size: 204 bytes --] Hi Guix, This is a v2. It detects some more cases (e.g. python-dateutil dejagnu and eigen). It also allows letting '#:phases' be a G-exp. With thanks to Mathieu Othacehe. Greetings, Maxime. [-- Attachment #1.2: v2-0001-guix-gexp-Define-gexp-approximate-sexp.patch --] [-- Type: text/x-patch, Size: 4858 bytes --] From 8e898a6c0f3dfa086f1414115fb2f58fe36224b1 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Mon, 28 Jun 2021 19:24:44 +0200 Subject: [PATCH v2 1/2] guix: gexp: Define gexp->approximate-sexp. To: 48320@debbugs.gnu.org Cc: Mathieu Othacehe <othacehe@gnu.org> It will be used in the 'optional-tests' linter. * guix/gexp.scm (gexp->approximate-sexp): New procedure. * tests/gexp.scm ("no references", "unquoted gexp", "unquoted gexp (native)") ("spliced gexp", "unspliced gexp, approximated") ("unquoted gexp, approximated"): Test it. * doc/gexp.scm ("G-Expressions"): Document it. --- doc/guix.texi | 11 +++++++++++ guix/gexp.scm | 19 +++++++++++++++++++ tests/gexp.scm | 31 +++++++++++++++++++++++++++++++ 3 files changed, 61 insertions(+) diff --git a/doc/guix.texi b/doc/guix.texi index 15e8999447..cc81c417a0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10038,6 +10038,17 @@ corresponding to @var{obj} for @var{system}, cross-compiling for has an associated gexp compiler, such as a @code{<package>}. @end deffn +@deffn {Procedure} gexp->approximate-sexp @var{gexp} +Sometimes, it may be useful to convert a G-exp into a S-exp. +For example, some linters (@pxref{Invoking guix lint}) +peek into the build phases of a package to detect potential +problems. This conversion can be achieved with this +procedure. However, some information can be lost in the +process. More specifically, lowerable objects will be silently +replaced with some arbitrary object -- currently the list +@code{(*approximate*)}, but this may change. +@end deffn + @node Invoking guix repl @section Invoking @command{guix repl} diff --git a/guix/gexp.scm b/guix/gexp.scm index 187f5c5e85..f3d278b3e6 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -42,6 +43,7 @@ with-imported-modules with-extensions let-system + gexp->approximate-sexp gexp-input gexp-input? @@ -157,6 +159,23 @@ "Return the source code location of GEXP." (and=> (%gexp-location gexp) source-properties->location)) +(define* (gexp->approximate-sexp gexp) + "Return the S-expression corresponding to GEXP, but do not lower anything. +As a result, the S-expression will be approximate if GEXP has references." + (define (gexp-like? thing) + (or (gexp? thing) (gexp-input? thing))) + (apply (gexp-proc gexp) + (map (lambda (reference) + (match reference + (($ <gexp-input> thing output native) + (if (gexp-like? thing) + (gexp->approximate-sexp thing) + ;; Simply returning 'thing' won't work in some + ;; situations; see 'write-gexp' below. + '(*approximate*))) + (_ '(*approximate*)))) + (gexp-references gexp)))) + (define (write-gexp gexp port) "Write GEXP on PORT." (display "#<gexp " port) diff --git a/tests/gexp.scm b/tests/gexp.scm index 834e78b9a0..39a47d4e8c 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -89,6 +90,36 @@ \f (test-begin "gexp") +(test-equal "no references" + '(display "hello gexp->approximate-sexp!") + (gexp->approximate-sexp #~(display "hello gexp->approximate-sexp!"))) + +(test-equal "unquoted gexp" + '(display "hello") + (let ((inside #~"hello")) + (gexp->approximate-sexp #~(display #$inside)))) + +(test-equal "unquoted gexp (native)" + '(display "hello") + (let ((inside #~"hello")) + (gexp->approximate-sexp #~(display #+inside)))) + +(test-equal "spliced gexp" + '(display '(fresh vegetables)) + (let ((inside #~(fresh vegetables))) + (gexp->approximate-sexp #~(display '(#$@inside))))) + +(test-equal "unspliced gexp, approximated" + ;; (*approximate*) is really an implementation detail + '(display '(*approximate*)) + (let ((inside (file-append coreutils "/bin/hello"))) + (gexp->approximate-sexp #~(display '(#$@inside))))) + +(test-equal "unquoted gexp, approximated" + '(display '(*approximate*)) + (let ((inside (file-append coreutils "/bin/hello"))) + (gexp->approximate-sexp #~(display '#$inside)))) + (test-equal "no refs" '(display "hello!") (let ((exp (gexp (display "hello!")))) -- 2.32.0 [-- Attachment #1.3: v2-0002-lint-Verify-if-tests-is-respected-in-the-check-ph.patch --] [-- Type: text/x-patch, Size: 8392 bytes --] From 604cd00c3fcce436d23f05ff7496a6ea1200594e Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Mon, 28 Jun 2021 20:44:16 +0200 Subject: [PATCH v2 2/2] lint: Verify if #:tests? is respected in the 'check' phase. To: 48320@debbugs.gnu.org Cc: Mathieu Othacehe <othacehe@gnu.org> There have been a few patches to the mailing list lately not respecting this, and this linter detects 368 package definitions that could be modified to support the --without-tests package transformation. * guix/lint.scm (check-optional-tests): New linter. (%local-checkers)[optional-tests]: Add it. * tests/lint.scm (package-with-phase-changes): New procedure. ("optional-tests: no check phase") ("optional-tests: check hase respects #:tests?") ("optional-tests: check phase ignores #:tests?") ("optional-tests: do not crash when #:phases is invalid") ("optional-tests: allow G-exps (no warning)") ("optional-tests: allow G-exps (warning)") ("optional-tests: complicated 'check' phase"): New tests. --- guix/lint.scm | 60 ++++++++++++++++++++++++++++++++++++++++++++- tests/lint.scm | 66 +++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 124 insertions(+), 2 deletions(-) diff --git a/guix/lint.scm b/guix/lint.scm index d65d5ce8f9..7fdc330306 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -40,7 +40,8 @@ #:use-module (guix packages) #:use-module (guix i18n) #:use-module ((guix gexp) - #:select (local-file? local-file-absolute-file-name)) + #:select (gexp? local-file? local-file-absolute-file-name + gexp->approximate-sexp)) #:use-module (guix licenses) #:use-module (guix records) #:use-module (guix grafts) @@ -88,6 +89,7 @@ check-source check-source-file-name check-source-unstable-tarball + check-optional-tests check-mirror-url check-github-url check-license @@ -1050,6 +1052,58 @@ descriptions maintained upstream." (define exception-with-kind-and-args? (exception-predicate &exception-with-kind-and-args)) +(define (check-optional-tests package) + "Emit a warning if the test suite is run unconditionally." + (define (sexp-uses-tests?? sexp) + "Test if SEXP contains the symbol 'tests?'." + (sexp-contains-atom? sexp 'tests?)) + (define (sexp-contains-atom? sexp atom) + "Test if SEXP contains ATOM." + (if (pair? sexp) + (or (sexp-contains-atom? (car sexp) atom) + (sexp-contains-atom? (cdr sexp) atom)) + (eq? sexp atom))) + (define (check-check-procedure expression) + (match expression + (`(,(or 'let 'let*) . ,_) + (check-check-procedure (car (last-pair expression)))) + (`(,(or 'lambda 'lambda*) ,_ . ,code) + (if (sexp-uses-tests?? code) + '() + (list (make-warning package + ;; TRANSLATORS: check and #:tests? are a + ;; Scheme symbol and keyword respectively + ;; and should not be translated. + (G_ "the 'check' phase should respect #:tests?") + #:field 'arguments)))) + (_ '()))) + (define (check-phases-delta delta) + (match delta + (`(replace 'check ,expression) + (check-check-procedure expression)) + (_ '()))) + (define (check-phases-deltas deltas) + (match deltas + (() '()) + ((head . tail) + (or (check-phases-delta head) + (check-phases-deltas tail))) + (_ (list (make-warning package + ;; TRANSLATORS: modify-phases is a Scheme + ;; syntax and must not be translated. + (G_ "incorrect call to ‘modify-phases’") + #:field 'arguments))))) + (apply (lambda* (#:key phases #:allow-other-keys) + (define phases/sexp + (if (gexp? phases) + (gexp->approximate-sexp phases) + phases)) + (match phases/sexp + (`(modify-phases ,_ . ,changes) + (check-phases-deltas changes)) + (_ '()))) + (package-arguments package))) + (define* (check-derivation package #:key store) "Emit a warning if we fail to compile PACKAGE to a derivation." (define (try store system) @@ -1590,6 +1644,10 @@ them for PACKAGE." (description "Make sure the 'license' field is a <license> \ or a list thereof") (check check-license)) + (lint-checker + (name 'optional-tests) + (description "Make sure tests are only run when requested") + (check check-optional-tests)) (lint-checker (name 'mirror-url) (description "Suggest 'mirror://' URLs") diff --git a/tests/lint.scm b/tests/lint.scm index fae346e724..33705f7cd3 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -38,7 +39,7 @@ #:use-module (guix lint) #:use-module (guix ui) #:use-module (guix swh) - #:use-module ((guix gexp) #:select (local-file)) + #:use-module ((guix gexp) #:select (gexp local-file gexp?)) #:use-module ((guix utils) #:select (call-with-temporary-directory)) #:use-module ((guix import hackage) #:select (%hackage-url)) #:use-module ((guix import stackage) #:select (%stackage-url)) @@ -744,6 +745,69 @@ (sha256 %null-sha256)))))) (check-source-unstable-tarball pkg))) +(define (package-with-phase-changes changes) + (dummy-package "x" + (arguments `(#:phases + ,(if (gexp? changes) + #~(modify-phases %standard-phases + #$@changes) + `(modify-phases %standard-phases + ,@changes)))))) + +(test-equal "optional-tests: no check phase" + '() + (let ((pkg (package-with-phase-changes '()))) + (check-optional-tests pkg))) + +(test-equal "optional-tests: check phase respects #:tests?" + '() + (let ((pkg (package-with-phase-changes + '((replace 'check + (lambda* (#:key tests? #:allow-other-keys?) + (when tests? + (invoke "./the-test-suite")))))))) + (check-optional-tests pkg))) + +(test-equal "optional-tests: check phase ignores #:tests?" + "the 'check' phase should respect #:tests?" + (let ((pkg (package-with-phase-changes + '((replace 'check + (lambda _ + (invoke "./the-test-suite"))))))) + (single-lint-warning-message + (check-optional-tests pkg)))) + +(test-equal "optional-tests: do not crash when #:phases is invalid" + "incorrect call to ‘modify-phases’" + (let ((pkg (package-with-phase-changes 'this-is-not-a-list))) + (single-lint-warning-message + (check-optional-tests pkg)))) + +(test-equal "optional-tests: allow G-exps (no warning)" + '() + (let ((pkg (package-with-phase-changes #~()))) + (check-optional-tests pkg))) + +(test-equal "optional-tests: allow G-exps (warning)" + "the 'check' phase should respect #:tests?" + (let ((pkg (package-with-phase-changes + #~((replace 'check + (lambda _ + (invoke "/the-test-suite"))))))) + (single-lint-warning-message + (check-optional-tests pkg)))) + +(test-equal "optional-tests: complicated 'check' phase" + "the 'check' phase should respect #:tests?" + (let ((pkg (package-with-phase-changes + '((replace 'check + (lambda* (#:key inputs tests? #:allow-other-keys) + (let ((something (stuff from inputs or native-inputs))) + (delete-file "dateutil/test/test_utils.py") + (invoke "pytest" "-vv")))))))) + (single-lint-warning-message + (check-optional-tests pkg)))) + (test-equal "source: 200" '() (with-http-server `((200 ,%long-string)) -- 2.32.0 [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 260 bytes --] ^ permalink raw reply related [flat|nested] 7+ messages in thread
* [bug#48320] [PATCH v2] lint: Verify if #:tests? is respected in the 'check' phase. 2021-06-28 21:15 ` [bug#48320] [PATCH v2] " Maxime Devos @ 2021-06-29 10:34 ` Mathieu Othacehe 2021-06-30 10:31 ` [bug#48320] [PATCH v3] " Maxime Devos 0 siblings, 1 reply; 7+ messages in thread From: Mathieu Othacehe @ 2021-06-29 10:34 UTC (permalink / raw) To: Maxime Devos; +Cc: 48320 Hello Maxime, Thanks for the new revision. > +@deffn {Procedure} gexp->approximate-sexp @var{gexp} > +Sometimes, it may be useful to convert a G-exp into a S-exp. > +For example, some linters (@pxref{Invoking guix lint}) You can write longer sentences here, up to 78 columns. If you are using Emacs, fill-paragraph does the right thing. > + (define (sexp-uses-tests?? sexp) > + "Test if SEXP contains the symbol 'tests?'." > + (sexp-contains-atom? sexp 'tests?)) > + (define (sexp-contains-atom? sexp atom) > + "Test if SEXP contains ATOM." > + (if (pair? sexp) > + (or (sexp-contains-atom? (car sexp) atom) > + (sexp-contains-atom? (cdr sexp) atom)) > + (eq? sexp atom))) It would make more sense to define "sexp-uses-tests??" later as it uses "sexp-contains-atom" that is defined afterwards. > + (or (check-phases-delta head) > + (check-phases-deltas tail))) I think it should be "append" instead of "or". Otherwise, it fails to detect package which 'replace is not the first phase, see mkvtoolnix for instance. Otherwise looks fine :) Thanks, Mathieu ^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#48320] [PATCH v3] lint: Verify if #:tests? is respected in the 'check' phase. 2021-06-29 10:34 ` Mathieu Othacehe @ 2021-06-30 10:31 ` Maxime Devos 2021-06-30 11:55 ` bug#48320: " Mathieu Othacehe 0 siblings, 1 reply; 7+ messages in thread From: Maxime Devos @ 2021-06-30 10:31 UTC (permalink / raw) To: Mathieu Othacehe; +Cc: 48320 [-- Attachment #1.1: Type: text/plain, Size: 1463 bytes --] Mathieu Othacehe schreef op di 29-06-2021 om 12:34 [+0200]: > Hello Maxime, > > Thanks for the new revision. > > > +@deffn {Procedure} gexp->approximate-sexp @var{gexp} > > +Sometimes, it may be useful to convert a G-exp into a S-exp. > > +For example, some linters (@pxref{Invoking guix lint}) > > You can write longer sentences here, up to 78 columns. If you are using > Emacs, fill-paragraph does the right thing. I did a "fill-paragraph" in the v3. > > + (define (sexp-uses-tests?? sexp) > > + "Test if SEXP contains the symbol 'tests?'." > > + (sexp-contains-atom? sexp 'tests?)) > > + (define (sexp-contains-atom? sexp atom) > > + "Test if SEXP contains ATOM." > > + (if (pair? sexp) > > + (or (sexp-contains-atom? (car sexp) atom) > > + (sexp-contains-atom? (cdr sexp) atom)) > > + (eq? sexp atom))) > > It would make more sense to define "sexp-uses-tests??" later as it uses > "sexp-contains-atom" that is defined afterwards. Indeed. I switched these two procedures around in the v3. > > + (or (check-phases-delta head) > > + (check-phases-deltas tail))) > > I think it should be "append" instead of "or". Otherwise, it fails to > detect package which 'replace is not the first phase, see mkvtoolnix for > instance. Indeed. I added a test case and replaced "or" with "append". The linter now detects about 300 additional cases. Greetings, Maxime. [-- Attachment #1.2: v3-0001-guix-gexp-Define-gexp-approximate-sexp.patch --] [-- Type: text/x-patch, Size: 4791 bytes --] From 5835b32d916681db73fb2d91b3646d915bfbd0a8 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Mon, 28 Jun 2021 19:24:44 +0200 Subject: [PATCH v3 1/2] guix: gexp: Define gexp->approximate-sexp. It will be used in the 'optional-tests' linter. * guix/gexp.scm (gexp->approximate-sexp): New procedure. * tests/gexp.scm ("no references", "unquoted gexp", "unquoted gexp (native)") ("spliced gexp", "unspliced gexp, approximated") ("unquoted gexp, approximated"): Test it. * doc/gexp.scm ("G-Expressions"): Document it. --- doc/guix.texi | 10 ++++++++++ guix/gexp.scm | 19 +++++++++++++++++++ tests/gexp.scm | 31 +++++++++++++++++++++++++++++++ 3 files changed, 60 insertions(+) diff --git a/doc/guix.texi b/doc/guix.texi index 15e8999447..f051373571 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10038,6 +10038,16 @@ corresponding to @var{obj} for @var{system}, cross-compiling for has an associated gexp compiler, such as a @code{<package>}. @end deffn +@deffn {Procedure} gexp->approximate-sexp @var{gexp} +Sometimes, it may be useful to convert a G-exp into a S-exp. For +example, some linters (@pxref{Invoking guix lint}) peek into the build +phases of a package to detect potential problems. This conversion can +be achieved with this procedure. However, some information can be lost +in the process. More specifically, lowerable objects will be silently +replaced with some arbitrary object -- currently the list +@code{(*approximate*)}, but this may change. +@end deffn + @node Invoking guix repl @section Invoking @command{guix repl} diff --git a/guix/gexp.scm b/guix/gexp.scm index 187f5c5e85..f3d278b3e6 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -42,6 +43,7 @@ with-imported-modules with-extensions let-system + gexp->approximate-sexp gexp-input gexp-input? @@ -157,6 +159,23 @@ "Return the source code location of GEXP." (and=> (%gexp-location gexp) source-properties->location)) +(define* (gexp->approximate-sexp gexp) + "Return the S-expression corresponding to GEXP, but do not lower anything. +As a result, the S-expression will be approximate if GEXP has references." + (define (gexp-like? thing) + (or (gexp? thing) (gexp-input? thing))) + (apply (gexp-proc gexp) + (map (lambda (reference) + (match reference + (($ <gexp-input> thing output native) + (if (gexp-like? thing) + (gexp->approximate-sexp thing) + ;; Simply returning 'thing' won't work in some + ;; situations; see 'write-gexp' below. + '(*approximate*))) + (_ '(*approximate*)))) + (gexp-references gexp)))) + (define (write-gexp gexp port) "Write GEXP on PORT." (display "#<gexp " port) diff --git a/tests/gexp.scm b/tests/gexp.scm index 834e78b9a0..39a47d4e8c 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -89,6 +90,36 @@ \f (test-begin "gexp") +(test-equal "no references" + '(display "hello gexp->approximate-sexp!") + (gexp->approximate-sexp #~(display "hello gexp->approximate-sexp!"))) + +(test-equal "unquoted gexp" + '(display "hello") + (let ((inside #~"hello")) + (gexp->approximate-sexp #~(display #$inside)))) + +(test-equal "unquoted gexp (native)" + '(display "hello") + (let ((inside #~"hello")) + (gexp->approximate-sexp #~(display #+inside)))) + +(test-equal "spliced gexp" + '(display '(fresh vegetables)) + (let ((inside #~(fresh vegetables))) + (gexp->approximate-sexp #~(display '(#$@inside))))) + +(test-equal "unspliced gexp, approximated" + ;; (*approximate*) is really an implementation detail + '(display '(*approximate*)) + (let ((inside (file-append coreutils "/bin/hello"))) + (gexp->approximate-sexp #~(display '(#$@inside))))) + +(test-equal "unquoted gexp, approximated" + '(display '(*approximate*)) + (let ((inside (file-append coreutils "/bin/hello"))) + (gexp->approximate-sexp #~(display '#$inside)))) + (test-equal "no refs" '(display "hello!") (let ((exp (gexp (display "hello!")))) -- 2.32.0 [-- Attachment #1.3: v3-0002-lint-Verify-if-tests-is-respected-in-the-check-ph.patch --] [-- Type: text/x-patch, Size: 8820 bytes --] From c16022f0c18d596678bdba82cd123ba6dae96a60 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Mon, 28 Jun 2021 20:44:16 +0200 Subject: [PATCH v3 2/2] lint: Verify if #:tests? is respected in the 'check' phase. There have been a few patches to the mailing list lately not respecting this, and this linter detects 630 package definitions that could be modified to support the --without-tests package transformation. * guix/lint.scm (check-optional-tests): New linter. (%local-checkers)[optional-tests]: Add it. * tests/lint.scm (package-with-phase-changes): New procedure. ("optional-tests: no check phase") ("optional-tests: check hase respects #:tests?") ("optional-tests: check phase ignores #:tests?") ("optional-tests: do not crash when #:phases is invalid") ("optional-tests: allow G-exps (no warning)") ("optional-tests: allow G-exps (warning)") ("optional-tests: complicated 'check' phase") ("optional-tests: 'check' phase is not first phase"): New tests. --- guix/lint.scm | 60 ++++++++++++++++++++++++++++++++++++++- tests/lint.scm | 77 +++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 135 insertions(+), 2 deletions(-) diff --git a/guix/lint.scm b/guix/lint.scm index d65d5ce8f9..c637929c38 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -40,7 +40,8 @@ #:use-module (guix packages) #:use-module (guix i18n) #:use-module ((guix gexp) - #:select (local-file? local-file-absolute-file-name)) + #:select (gexp? local-file? local-file-absolute-file-name + gexp->approximate-sexp)) #:use-module (guix licenses) #:use-module (guix records) #:use-module (guix grafts) @@ -88,6 +89,7 @@ check-source check-source-file-name check-source-unstable-tarball + check-optional-tests check-mirror-url check-github-url check-license @@ -1050,6 +1052,58 @@ descriptions maintained upstream." (define exception-with-kind-and-args? (exception-predicate &exception-with-kind-and-args)) +(define (check-optional-tests package) + "Emit a warning if the test suite is run unconditionally." + (define (sexp-contains-atom? sexp atom) + "Test if SEXP contains ATOM." + (if (pair? sexp) + (or (sexp-contains-atom? (car sexp) atom) + (sexp-contains-atom? (cdr sexp) atom)) + (eq? sexp atom))) + (define (sexp-uses-tests?? sexp) + "Test if SEXP contains the symbol 'tests?'." + (sexp-contains-atom? sexp 'tests?)) + (define (check-check-procedure expression) + (match expression + (`(,(or 'let 'let*) . ,_) + (check-check-procedure (car (last-pair expression)))) + (`(,(or 'lambda 'lambda*) ,_ . ,code) + (if (sexp-uses-tests?? code) + '() + (list (make-warning package + ;; TRANSLATORS: check and #:tests? are a + ;; Scheme symbol and keyword respectively + ;; and should not be translated. + (G_ "the 'check' phase should respect #:tests?") + #:field 'arguments)))) + (_ '()))) + (define (check-phases-delta delta) + (match delta + (`(replace 'check ,expression) + (check-check-procedure expression)) + (_ '()))) + (define (check-phases-deltas deltas) + (match deltas + (() '()) + ((head . tail) + (append (check-phases-delta head) + (check-phases-deltas tail))) + (_ (list (make-warning package + ;; TRANSLATORS: modify-phases is a Scheme + ;; syntax and must not be translated. + (G_ "incorrect call to ‘modify-phases’") + #:field 'arguments))))) + (apply (lambda* (#:key phases #:allow-other-keys) + (define phases/sexp + (if (gexp? phases) + (gexp->approximate-sexp phases) + phases)) + (match phases/sexp + (`(modify-phases ,_ . ,changes) + (check-phases-deltas changes)) + (_ '()))) + (package-arguments package))) + (define* (check-derivation package #:key store) "Emit a warning if we fail to compile PACKAGE to a derivation." (define (try store system) @@ -1590,6 +1644,10 @@ them for PACKAGE." (description "Make sure the 'license' field is a <license> \ or a list thereof") (check check-license)) + (lint-checker + (name 'optional-tests) + (description "Make sure tests are only run when requested") + (check check-optional-tests)) (lint-checker (name 'mirror-url) (description "Suggest 'mirror://' URLs") diff --git a/tests/lint.scm b/tests/lint.scm index fae346e724..4ef400a9a0 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -38,7 +39,7 @@ #:use-module (guix lint) #:use-module (guix ui) #:use-module (guix swh) - #:use-module ((guix gexp) #:select (local-file)) + #:use-module ((guix gexp) #:select (gexp local-file gexp?)) #:use-module ((guix utils) #:select (call-with-temporary-directory)) #:use-module ((guix import hackage) #:select (%hackage-url)) #:use-module ((guix import stackage) #:select (%stackage-url)) @@ -744,6 +745,80 @@ (sha256 %null-sha256)))))) (check-source-unstable-tarball pkg))) +(define (package-with-phase-changes changes) + (dummy-package "x" + (arguments `(#:phases + ,(if (gexp? changes) + #~(modify-phases %standard-phases + #$@changes) + `(modify-phases %standard-phases + ,@changes)))))) + +(test-equal "optional-tests: no check phase" + '() + (let ((pkg (package-with-phase-changes '()))) + (check-optional-tests pkg))) + +(test-equal "optional-tests: check phase respects #:tests?" + '() + (let ((pkg (package-with-phase-changes + '((replace 'check + (lambda* (#:key tests? #:allow-other-keys?) + (when tests? + (invoke "./the-test-suite")))))))) + (check-optional-tests pkg))) + +(test-equal "optional-tests: check phase ignores #:tests?" + "the 'check' phase should respect #:tests?" + (let ((pkg (package-with-phase-changes + '((replace 'check + (lambda _ + (invoke "./the-test-suite"))))))) + (single-lint-warning-message + (check-optional-tests pkg)))) + +(test-equal "optional-tests: do not crash when #:phases is invalid" + "incorrect call to ‘modify-phases’" + (let ((pkg (package-with-phase-changes 'this-is-not-a-list))) + (single-lint-warning-message + (check-optional-tests pkg)))) + +(test-equal "optional-tests: allow G-exps (no warning)" + '() + (let ((pkg (package-with-phase-changes #~()))) + (check-optional-tests pkg))) + +(test-equal "optional-tests: allow G-exps (warning)" + "the 'check' phase should respect #:tests?" + (let ((pkg (package-with-phase-changes + #~((replace 'check + (lambda _ + (invoke "/the-test-suite"))))))) + (single-lint-warning-message + (check-optional-tests pkg)))) + +(test-equal "optional-tests: complicated 'check' phase" + "the 'check' phase should respect #:tests?" + (let ((pkg (package-with-phase-changes + '((replace 'check + (lambda* (#:key inputs tests? #:allow-other-keys) + (let ((something (stuff from inputs or native-inputs))) + (delete-file "dateutil/test/test_utils.py") + (invoke "pytest" "-vv")))))))) + (single-lint-warning-message + (check-optional-tests pkg)))) + +(test-equal "optional-tests: 'check' phase is not first phase" + "the 'check' phase should respect #:tests?" + (let ((pkg (package-with-phase-changes + '((add-after 'unpack + (lambda _ + (chdir "libtestcase-0.0.0"))) + (replace 'check + (lambda _ (invoke "./test-suite"))))))) + (single-lint-warning-message + (check-optional-tests pkg)))) + (test-equal "source: 200" '() (with-http-server `((200 ,%long-string)) -- 2.32.0 [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 260 bytes --] ^ permalink raw reply related [flat|nested] 7+ messages in thread
* bug#48320: [PATCH v3] lint: Verify if #:tests? is respected in the 'check' phase. 2021-06-30 10:31 ` [bug#48320] [PATCH v3] " Maxime Devos @ 2021-06-30 11:55 ` Mathieu Othacehe 0 siblings, 0 replies; 7+ messages in thread From: Mathieu Othacehe @ 2021-06-30 11:55 UTC (permalink / raw) To: Maxime Devos; +Cc: 48320-done Hey, > Indeed. I added a test case and replaced "or" with "append". The linter > now detects about 300 additional cases. Great, pushed on master. We now have some work to fix those ~600 packages! Thanks, Mathieu ^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2021-06-30 11:56 UTC | newest] Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed) -- links below jump to the message on this page -- 2021-05-09 18:02 [bug#48320] [PATCH] lint: Verify if #:tests? is respected in the 'check' phase Maxime Devos 2021-06-18 12:15 ` Mathieu Othacehe 2021-06-18 15:34 ` Maxime Devos 2021-06-28 21:15 ` [bug#48320] [PATCH v2] " Maxime Devos 2021-06-29 10:34 ` Mathieu Othacehe 2021-06-30 10:31 ` [bug#48320] [PATCH v3] " Maxime Devos 2021-06-30 11:55 ` bug#48320: " Mathieu Othacehe
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/guix.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.