From patchwork Wed Jun 30 10:31:57 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: M X-Patchwork-Id: 30839 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 5AFE127BC81; Wed, 30 Jun 2021 11:35:11 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, FREEMAIL_FROM,MAILING_LIST_MULTI,SPF_HELO_PASS,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 7450527BC78 for ; Wed, 30 Jun 2021 11:35:10 +0100 (BST) Received: from localhost ([::1]:48750 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lyXYj-0001y3-G2 for patchwork@mira.cbaines.net; Wed, 30 Jun 2021 06:35:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:49748) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lyXYc-0001xc-HX for guix-patches@gnu.org; Wed, 30 Jun 2021 06:35:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:44980) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lyXYc-0002wt-AZ for guix-patches@gnu.org; Wed, 30 Jun 2021 06:35:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lyXYc-0001LN-46 for guix-patches@gnu.org; Wed, 30 Jun 2021 06:35:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#48320] [PATCH v3] lint: Verify if #:tests? is respected in the 'check' phase. Resent-From: Maxime Devos Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 30 Jun 2021 10:35:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 48320 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Mathieu Othacehe Cc: 48320@debbugs.gnu.org Received: via spool by 48320-submit@debbugs.gnu.org id=B48320.16250492685113 (code B ref 48320); Wed, 30 Jun 2021 10:35:02 +0000 Received: (at 48320) by debbugs.gnu.org; 30 Jun 2021 10:34:28 +0000 Received: from localhost ([127.0.0.1]:56526 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lyXXz-0001KB-9m for submit@debbugs.gnu.org; Wed, 30 Jun 2021 06:34:28 -0400 Received: from michel.telenet-ops.be ([195.130.137.88]:35146) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lyXXv-0001Jz-IF for 48320@debbugs.gnu.org; Wed, 30 Jun 2021 06:34:21 -0400 Received: from butterfly.local ([188.189.254.236]) by michel.telenet-ops.be with bizsmtp id PNaG2500C56nx8C06NaHzP; Wed, 30 Jun 2021 12:34:17 +0200 Message-ID: From: Maxime Devos Date: Wed, 30 Jun 2021 12:31:57 +0200 In-Reply-To: <87h7hhvu0n.fsf@gnu.org> References: <2b0fee1845a66e1fb126b4bbf1c9892b7c648a3a.camel@telenet.be> <44f0c8b823b0f6f8e5388ff6c1d90e76fa09bf2c.camel@telenet.be> <87h7hhvu0n.fsf@gnu.org> User-Agent: Evolution 3.34.2 MIME-Version: 1.0 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=telenet.be; s=r21; t=1625049257; bh=44sBkRXfqynIHLiiL/Fa7op0w5Fpg1VwKNV+V0hyv4M=; h=Subject:From:To:Cc:Date:In-Reply-To:References; b=gherYjtdMk396o7/qlupTQPkJch7FzxmLFNFD2smQNZ7XaGZYDIuzQF4D/LgN1S7j HjzppK2yrnWiIMs52jyXCJiaRvU6CpL+dL7g8eqcsWCLb/tTjKE0BOVfU0aXsRdc/x zaqRx1LjYUok9tq5UToRcTJ4a6U+pW3Fqt7/Swasj4xiSs+ZBxP2ifMBj312veIK+E I2ksS5fMktCNaGszX+W04CXqBkxey++Ig0RW3Sbf2Z0lMm/zBtfPkRsd72/N66srQX KE6GnN9LTmLaSj54Nw7Y8mtlbBE7b8+2rJPZcuscGqf6sSZq4+kTQtfiKPIZpYqCLu cPIqP7xP7sDng== X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches 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. From c16022f0c18d596678bdba82cd123ba6dae96a60 Mon Sep 17 00:00:00 2001 From: Maxime Devos 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 \ 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 ;;; Copyright © 2020 Timothy Sample ;;; Copyright © 2021 Xinglu Chen +;;; Copyright © 2021 Maxime Devos ;;; ;;; 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