From unknown Fri Sep 05 20:54:50 2025 X-Loop: help-debbugs@gnu.org Subject: bug#24618: 26.0.50; `condition-case' doesn't allow catching all signals Resent-From: Philipp Stephani Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 04 Oct 2016 16:43:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 24618 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: To: 24618@debbugs.gnu.org X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.147559936412856 (code B ref -1); Tue, 04 Oct 2016 16:43:01 +0000 Received: (at submit) by debbugs.gnu.org; 4 Oct 2016 16:42:44 +0000 Received: from localhost ([127.0.0.1]:44775 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1brSnj-0003LI-QF for submit@debbugs.gnu.org; Tue, 04 Oct 2016 12:42:44 -0400 Received: from eggs.gnu.org ([208.118.235.92]:53807) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1brSni-0003L3-6j for submit@debbugs.gnu.org; Tue, 04 Oct 2016 12:42:42 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1brSnb-0000oJ-LR for submit@debbugs.gnu.org; Tue, 04 Oct 2016 12:42:37 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: * X-Spam-Status: No, score=1.1 required=5.0 tests=BAYES_50, FREEMAIL_ENVFROM_END_DIGIT,FREEMAIL_FROM,T_DKIM_INVALID autolearn=disabled version=3.3.2 Received: from lists.gnu.org ([2001:4830:134:3::11]:45718) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1brSnb-0000o3-Hy for submit@debbugs.gnu.org; Tue, 04 Oct 2016 12:42:35 -0400 Received: from eggs.gnu.org ([2001:4830:134:3::10]:44771) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1brSnY-0002NC-Uk for bug-gnu-emacs@gnu.org; Tue, 04 Oct 2016 12:42:34 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1brSnW-0000n0-KH for bug-gnu-emacs@gnu.org; Tue, 04 Oct 2016 12:42:31 -0400 Received: from mail-wm0-x235.google.com ([2a00:1450:400c:c09::235]:38607) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1brSnW-0000me-7Y for bug-gnu-emacs@gnu.org; Tue, 04 Oct 2016 12:42:30 -0400 Received: by mail-wm0-x235.google.com with SMTP id p138so222205473wmb.1 for ; Tue, 04 Oct 2016 09:42:30 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:subject:date:message-id:mime-version :content-transfer-encoding; bh=d8n3FeKNSoBxdGdcSMZBHPAeZ/7FPuq13zu9uqNTPxs=; b=eiLP90dyZjbrWaIqCkFjDIoN8M6VzFaCOEHEOnB1AzbNOkExRxyo8UHF7R/3w2vO/T AC+VHZx7QNUcKBOFr7WuvEko+N8gQN2GtQpki8AtU2q3CscVXNsdg75SF1wD3LOhHBw8 YuMyFl+vhfel+MNBLro04uTjmv5dQBM51JIX1byI373MrcXFZNygig3ALyUcbnk6Qli9 WDX690zxPwEdJwpLPz/CPdQgdzmk7c1vIYqhyEUD297djJpZor0d3CjMH4/4GXmPUIsP o0E4rCR86smjeL9XRJDT5F1hUel4N12vAdy0vrRBHIAKwuGUUislE3LjeC80fgrcUBP4 LmSQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:from:to:subject:date:message-id:mime-version :content-transfer-encoding; bh=d8n3FeKNSoBxdGdcSMZBHPAeZ/7FPuq13zu9uqNTPxs=; b=FzIrhWoPssrZ402t8clOX34CcYzdA6zx9oAztRRI0115jVAyaDP8XSdNBEu6kwJxNi 7H5+F9iDrxf62WAZVTycBBYzHJa6PFSSK+6PFe5uOJmq/OlRSVT775y2I6qVCGuRoa0w ssdADtdQN7dLa3d1LCEkQ3tGbtS17UPKt5LI9ubO1GbNQSnegzTQaFqvdLisF/3X6Jh1 31iuz4t4lm6i+EyrxPYysRxcj5MLA6qmJ91tZiPaglU5xPPU3XKujh0pKixx3UX1I90f HyfQT71OFPFjPeDlxaw4Gb2qgZd0q7XmwLnYwuXZlOtJ5vHRdLfB2wgCtuhsKTPVf5pX 6fcw== X-Gm-Message-State: AA6/9RksJkTETvuGpZforW72AWrqw6J3uxzwLUPdCfX3qhNXltJz4/YXrhFk0wIfGEtp+w== X-Received: by 10.194.103.138 with SMTP id fw10mr3783826wjb.93.1475599349098; Tue, 04 Oct 2016 09:42:29 -0700 (PDT) Received: from a.muc.corp.google.com ([2a00:79e0:15:4:bd49:ce6e:c6fc:9780]) by smtp.gmail.com with ESMTPSA id f142sm4933598wmf.19.2016.10.04.09.42.28 for (version=TLS1_2 cipher=AES128-SHA bits=128/128); Tue, 04 Oct 2016 09:42:28 -0700 (PDT) From: Philipp Stephani Date: Tue, 04 Oct 2016 18:42:27 +0200 Message-ID: MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 2001:4830:134:3::11 X-Spam-Score: -3.8 (---) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.8 (---) Consider the following code: (condition-case err (signal 'does-not-exist '(1 2)) (error (print err))) The signal is not caught by condition-case because it has no error conditions. This makes it impossible to reliably catch all signals (without abusing the debugger). I propose that an error condition of 't' in `condition-case' should be interpreted as 'all conditions'. In GNU Emacs 26.0.50.1 (x86_64-unknown-linux-gnu, GTK+ Version 3.10.8) of 2016-10-04 built on unknown Repository revision: e2913dc880b9843bf69cf885270551bafeb46120 Windowing system distributor 'The X.Org Foundation', version 11.0.11501000 System Description: Ubuntu 14.04 LTS Recent messages: mwheel-scroll: Beginning of buffer [7 times] Mark set Sending... Mark set [2 times] Sending via mail... Setting =E2=80=98smtpmail-smtp-server=E2=80=99 temporarily since "emacs -q"= would overwrite customizations Setting =E2=80=98smtpmail-smtp-service=E2=80=99 temporarily since "emacs -q= " would overwrite customizations Sending email=20 Sending email done Sending...done Configured using: 'configure --with-modules --enable-checking --enable-check-lisp-object-type' Configured features: XPM JPEG TIFF GIF PNG SOUND GSETTINGS NOTIFY GNUTLS FREETYPE XFT ZLIB TOOLKIT_SCROLL_BARS GTK3 X11 MODULES Important settings: value of $LANG: en_US.UTF-8 locale-coding-system: utf-8-unix Major mode: Lisp Interaction Minor modes in effect: tooltip-mode: t global-eldoc-mode: t electric-indent-mode: t mouse-wheel-mode: t tool-bar-mode: t menu-bar-mode: t file-name-shadow-mode: t global-font-lock-mode: t font-lock-mode: t blink-cursor-mode: t auto-composition-mode: t auto-encryption-mode: t auto-compression-mode: t line-number-mode: t transient-mark-mode: t Load-path shadows: None found. Features: (network-stream nsm starttls tls gnutls mailalias smtpmail auth-source cl-seq eieio eieio-core cl-macs eieio-loaddefs qp cus-edit cus-start cus-load wid-edit pp shadow sort mail-extr emacsbug message subr-x puny seq byte-opt gv bytecomp byte-compile cl-extra help-mode cconv cl-loaddefs pcase cl-lib dired dired-loaddefs format-spec rfc822 mml easymenu mml-sec password-cache epa derived epg epg-config gnus-util rmail rmail-loaddefs mm-decode mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader sendmail rfc2047 rfc2045 ietf-drums mm-util mail-prsvr mail-utils time-date mule-util tooltip eldoc electric uniquify ediff-hook vc-hooks lisp-float-type mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe tabulated-list newcomment elisp-mode lisp-mode prog-mode register page menu-bar rfn-eshadow timer select scroll-bar mouse jit-lock font-lock syntax facemenu font-core term/tty-colors frame cl-generic cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european ethiopic indian cyrillic chinese charscript case-table epa-hook jka-cmpr-hook help simple abbrev obarray minibuffer cl-preloaded nadvice loaddefs button faces cus-face macroexp files text-properties overlay sha1 md5 base64 format env code-pages mule custom widget hashtable-print-readable backquote inotify dynamic-setting system-font-setting font-render-setting move-toolbar gtk x-toolkit x multi-tty make-network-process emacs) Memory information: ((conses 16 126071 14602) (symbols 48 22713 6) (miscs 40 341 241) (strings 32 23705 8690) (string-bytes 1 748309) (vectors 16 22599) (vector-slots 8 1236864 203799) (floats 8 222 372) (intervals 56 534 27) (buffers 976 15) (heap 1024 59649 5444)) --=20 Google Germany GmbH Erika-Mann-Stra=C3=9Fe 33 80636 M=C3=BCnchen Registergericht und -nummer: Hamburg, HRB 86891 Sitz der Gesellschaft: Hamburg Gesch=C3=A4ftsf=C3=BChrer: Matthew Scott Sucherman, Paul Terence Manicle Diese E-Mail ist vertraulich. Wenn Sie nicht der richtige Adressat sind, leiten Sie diese bitte nicht weiter, informieren Sie den Absender und l=C3= =B6schen Sie die E-Mail und alle Anh=C3=A4nge. Vielen Dank. This e-mail is confidential. If you are not the right addressee please do = not forward it, please inform the sender, and please erase this e-mail including any attachments. Thanks. From unknown Fri Sep 05 20:54:50 2025 X-Loop: help-debbugs@gnu.org Subject: bug#24618: 26.0.50; `condition-case' doesn't allow catching all signals Resent-From: Noam Postavsky Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 14 Aug 2018 02:39:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 24618 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: To: Philipp Stephani Cc: 24618@debbugs.gnu.org Received: via spool by 24618-submit@debbugs.gnu.org id=B24618.153421430825803 (code B ref 24618); Tue, 14 Aug 2018 02:39:02 +0000 Received: (at 24618) by debbugs.gnu.org; 14 Aug 2018 02:38:28 +0000 Received: from localhost ([127.0.0.1]:50056 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fpPE3-0006i1-95 for submit@debbugs.gnu.org; Mon, 13 Aug 2018 22:38:27 -0400 Received: from mail-it0-f41.google.com ([209.85.214.41]:52474) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fpPE1-0006hg-HW; Mon, 13 Aug 2018 22:38:25 -0400 Received: by mail-it0-f41.google.com with SMTP id d9-v6so16246480itf.2; Mon, 13 Aug 2018 19:38:25 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=OyXqdWKNKO7JHdlym8kz+iXVEBN9FwlwKSSX5aZPXOA=; b=SQBTkrFMiBJukIBMntgbY97iZMIysBWfGK2OcFph6/7nJnUtEFv3XRLAmycm/NVdaQ 33s5+z0rojHa9hUK3g1y2dYCdUSqfLV6O140FADKrMYzw5l9KrWzL9jKikuld/P1ZvJa 3D95UxJyoeo/6jXVhgl65rRLt61iiI0qX99UKXIjQeT7GBuO3aiuN5CS2z5sFXGv1q6v uBcUJZ5whA0hbiQmdOMO7ptlavVqjx7PJGuPtiZH6lUnRHSJcUY3XJfwe2kringvFSea vgqzs2qq6Dbsg87g7FtZy1LR+0w2yeQ7ny2BsSv3rcigLmbtykEbduMaeT/Y/iDc7kkm Bf0w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=OyXqdWKNKO7JHdlym8kz+iXVEBN9FwlwKSSX5aZPXOA=; b=IAl/vhBz7v/oM80cl6EkkDfUAUF5ew8vNK/blsJOK5wQiXGOhtnLpAo2M1/inSfL4k lgLdfj/X75kPSCxePJjSEuOU6k/Frp7of4IbMtr7prZICx48V0C0LHUupTMwB5Y8fp1/ e3Q2cX3B0WEOOnVzs/0Fjc2ByiwXe1G8Zn25aPJeofPiJNuoxip95WnZxMoFBhYQacJw gZpdX/32osgYSY/pVOxGPA4v0KTZs/sSW4o65v4JpqB+TjTzU8tHzvC2Rc0I2uHsndzS pMPZ5Pz0DXz/qdvR33g1In8TCIe7PBDUfk2IP4knPOP+AK9qmDwDmCpEvUIg0/2nrH8B XFHQ== X-Gm-Message-State: AOUpUlEP8PG8x7iONXyYhsb71mKrCAZnrwbz56VnyMqBUTxVEOvIwve9 QCmZM1DjtZ335HOASLaezWfl8vOq X-Google-Smtp-Source: AA+uWPzX9x21XF0ECswnVuzjKGQHNcdDhPc5t/vtGo211DAih22W+YmVrHBqY94hK+mw6sWrQrdlEQ== X-Received: by 2002:a02:1e41:: with SMTP id m62-v6mr17710026jad.110.1534214299863; Mon, 13 Aug 2018 19:38:19 -0700 (PDT) Received: from zebian (cbl-45-2-119-34.yyz.frontiernetworks.ca. [45.2.119.34]) by smtp.googlemail.com with ESMTPSA id i5-v6sm2333534ioq.5.2018.08.13.19.38.18 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Mon, 13 Aug 2018 19:38:18 -0700 (PDT) From: Noam Postavsky References: Date: Mon, 13 Aug 2018 22:38:17 -0400 In-Reply-To: (Philipp Stephani's message of "Tue, 04 Oct 2016 18:42:27 +0200") Message-ID: <87va8dvfja.fsf@gmail.com> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.1 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain tags 24618 + patch quit Philipp Stephani writes: > Consider the following code: > > (condition-case err > (signal 'does-not-exist '(1 2)) > (error (print err))) > > The signal is not caught by condition-case because it has no error > conditions. This makes it impossible to reliably catch all signals > (without abusing the debugger). Yeah, I noticed this when I started looking at fixing ert to stop abusing the debugger like this (Bug#30745 and Bug#11218). > I propose that an error condition of 't' in `condition-case' should be > interpreted as 'all conditions'. Seems easy enough: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Allow-t-as-a-catch-all-condition-case-handler-Bug-24.patch Content-Description: patch >From a18b70875fbcf22009e64bc9d809d1575fba3429 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 9 Aug 2018 21:26:30 -0400 Subject: [PATCH] Allow t as a catch-all condition-case handler (Bug#24618) * src/eval.c (find_handler_clause): Accept a handler of t as always matching. (Fcondition_case): * doc/lispref/control.texi (Handling Errors): Document this. * etc/NEWS: Announce it. --- doc/lispref/control.texi | 7 ++++--- etc/NEWS | 3 +++ src/eval.c | 10 ++++++---- 3 files changed, 13 insertions(+), 7 deletions(-) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 975ab3d075..8a6cf73af5 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1878,9 +1878,10 @@ Handling Errors Each of the @var{handlers} is a list of the form @code{(@var{conditions} @var{body}@dots{})}. Here @var{conditions} is an error condition name to be handled, or a list of condition names (which can include @code{debug} -to allow the debugger to run before the handler); @var{body} is one or more -Lisp expressions to be executed when this handler handles an error. -Here are examples of handlers: +to allow the debugger to run before the handler). A condition name of +@code{t} matches any condition. @var{body} is one or more Lisp +expressions to be executed when this handler handles an error. Here +are examples of handlers: @example @group diff --git a/etc/NEWS b/etc/NEWS index 8abbd74e05..f7de6c7295 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -836,6 +836,9 @@ specially; they are now allocated like any other pseudovector. * Lisp Changes in Emacs 27.1 +++ +** 'condition-case' now accepts 't' to match any error symbol. + ++++ ** New function 'proper-list-p'. Given a proper list as argument, this predicate returns its length; otherwise, it returns nil. 'format-proper-list-p' is now an obsolete diff --git a/src/eval.c b/src/eval.c index 8745ba9ef9..8700f0e202 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1215,9 +1215,9 @@ DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0, Each element of HANDLERS looks like (CONDITION-NAME BODY...) where the BODY is made of Lisp expressions. -A handler is applicable to an error -if CONDITION-NAME is one of the error's condition names. -If an error happens, the first applicable handler is run. +A handler is applicable to an error if CONDITION-NAME is one of the +error's condition names. A CONDITION-NAME of t applies to any error +symbol. If an error happens, the first applicable handler is run. The car of a handler may be a list of condition names instead of a single condition name; then it handles all of them. If the special @@ -1854,7 +1854,9 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions) for (h = handlers; CONSP (h); h = XCDR (h)) { Lisp_Object handler = XCAR (h); - if (!NILP (Fmemq (handler, conditions))) + if (!NILP (Fmemq (handler, conditions)) + /* t is also used as a catch-all by Lisp code. */ + || EQ (handler, Qt)) return handlers; } -- 2.11.0 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Aug 14 20:47:33 2018 Received: (at control) by debbugs.gnu.org; 15 Aug 2018 00:47:33 +0000 Received: from localhost ([127.0.0.1]:51196 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fpjyG-0000gi-Dv for submit@debbugs.gnu.org; Tue, 14 Aug 2018 20:47:33 -0400 Received: from mail-it0-f54.google.com ([209.85.214.54]:33429) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fpjyE-0000gO-03; Tue, 14 Aug 2018 20:47:31 -0400 Received: by mail-it0-f54.google.com with SMTP id d16-v6so16106365itj.0; Tue, 14 Aug 2018 17:47:29 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=OgJYPJWo5OZw6QUBqnDzO4uSmlQK5dXClIh5CRe9LkM=; b=ncKW+u/vLlGCV0HnEQdNtXh7LzpgSyBbHC66Lz1i7opPaSdjr6v2pMKdG2iflG314F 1MvksMXv6PpPNWB5DNwPCDO1D5ex/xNKyGdb6DgBfx6L/1zO05q3DcRtepf/qJZfVbXc 4CHfrjc+oqS52llf4zv+AWQHoPOFwXGLy6vFNjf6Cd515RMVkMAx2GkOi/WoTOCqoNnV E/KUxh8NFTv8CAvjW9+3laShN/gaRbFwySjpGXi0lwRmZ/ivxdkqoFyVVXrc8z2DovY5 f7113zWCTEl+jMb7wt0ABCk7/zI+y4BgncYCyZjMGnMoejdPkxOssG4bL5rhcK9dpFKy OAzA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=OgJYPJWo5OZw6QUBqnDzO4uSmlQK5dXClIh5CRe9LkM=; b=XeNzvXCRafXoaBMWHbwBzCndjoWu8TbPYXG1VmbmULmxI9TvU6dyFmQozKMrS1Y6az Bmr2cWAxC+zrCBMy2scnHHWKcCacvWDrmdpZTmaazbYpAbCW/Q9cCf26qmOXVk5RTIsr bzn8ZDTFxfa5lqWD+quVZCLO7R928+W+denxsSnC5hJplHZMvbA8HsAMRvJOEXCpLrCy P5HbG2ajPJ9avLx4w9lIaC3Sn0fDLT+eNJ0ILXz6z17j707wE9Ujyvh+109HJIZoArMP Dq6QRWN/Rq/TeFxRcN+FyxS0H/1fkA9PRlpSOyjt9J4eZ9x6CifgZIDEFgyt50/IN7x2 oI6A== X-Gm-Message-State: AOUpUlFHrU7w/cIBlEO+apG5OrzNCdBfBYuyDeTYIUojUcjdQK0m0sdR xigWqjGh14KodazXne5LosJZr8vF X-Google-Smtp-Source: AA+uWPxuizLxue5vEQeULnJGeKhiOi8tsOtb+thffQn4Q8NH6XIbK+bhag4QqDnE1tUUHxgoOg68bw== X-Received: by 2002:a02:4502:: with SMTP id y2-v6mr21858146jaa.11.1534294043916; Tue, 14 Aug 2018 17:47:23 -0700 (PDT) Received: from zebian (cbl-45-2-119-34.yyz.frontiernetworks.ca. [45.2.119.34]) by smtp.googlemail.com with ESMTPSA id x197-v6sm431350itb.5.2018.08.14.17.47.22 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 14 Aug 2018 17:47:22 -0700 (PDT) From: Noam Postavsky To: phillip.lord@russet.org.uk (Phillip Lord) Subject: Re: bug#30745: 26.0.91; ert should macros nest strangely References: <874llr4lk1.fsf@russet.org.uk> <87r2ov1l46.fsf@gmail.com> <87sh9blzfy.fsf@russet.org.uk> Date: Tue, 14 Aug 2018 20:47:21 -0400 In-Reply-To: <87sh9blzfy.fsf@russet.org.uk> (Phillip Lord's message of "Thu, 08 Mar 2018 08:54:41 +0000") Message-ID: <87lg98xxpi.fsf@gmail.com> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.1 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: control Cc: 30745@debbugs.gnu.org, 24402@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain block 30745 by 24618 tags 30745 + patch quit phillip.lord@russet.org.uk (Phillip Lord) writes: > Unfortunately, yes. I didn't try nesting two ert-deftest macros, just > two should's. As the original bug report suggests it's for testing a > test library (https://github.com/phillord/assess). > > I do have a work around now (which is to unnest the shoulds); and > fortunately, this work-around is backward compatible which is important > for me. I still have another test failure in my library, > though. Probably caused by the same thing but I haven't worked on it > yet. I have a patch for ert which removes it's (ab)use of the debugger, it seems to fix this case (and also Bug#11218). Note that it relies on my patch in #24618 for a catch-all condition-case handler clause. https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24618;filename=0001-Allow-t-as-a-catch-all-condition-case-handler-Bug-24.patch;msg=8;att=1 --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=v1-0001-Use-signal-hook-function-in-ert-not-debugger.patch Content-Description: patch >From e08577437af595325c950dad261a912093af76af Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Mon, 13 Aug 2018 21:33:04 -0400 Subject: [PATCH v1 1/3] Use signal-hook-function in ert, not debugger Stop (ab)using the `debugger' in ert.el for backtrace recording. Instead, use `signal-hook-function' for this purpose, which makes ert's behavior independent of `debug-on-error'. * lisp/emacs-lisp/ert.el (ert--should-signal-hook): Remove. (ert--expand-should-1): Don't bind signal-hook-function. (ert-debug-on-error): Obsolete, alias to debug-on-error (replace all uses accordingly). (ert--test-execution-info): Remove exit-continuation, next-debugger, and ert-debug-on-error fields. (ert--run-test-debugger): Remove. (ert--store-backtrace): New function, to replace it. (ert--run-test-internal): Use condition-case and bind `signal-hook-function' rather than binding `debugger'. (ert-run-test): Remove the `cl-block' for the now removed exit-continuation. * test/lisp/emacs-lisp/ert-tests.el (ert-test-fail-debug-nested-with-debugger): Remove. (ert-nested-should): New test (Bug#30745). (ert-with-demoted-errors): New test (Bug#11218). --- lisp/emacs-lisp/ert.el | 224 ++++++++++++++---------------------- test/lisp/emacs-lisp/ert-tests.el | 101 +++++++--------- test/lisp/emacs-lisp/ert-x-tests.el | 2 +- 3 files changed, 130 insertions(+), 197 deletions(-) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index eb9695d0c1..09b0240c90 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -266,14 +266,6 @@ ert--signal-should-execution (when ert--should-execution-observer (funcall ert--should-execution-observer form-description))) -;; See Bug#24402 for why this exists -(defun ert--should-signal-hook (error-symbol data) - "Stupid hack to stop `condition-case' from catching ert signals. -It should only be stopped when ran from inside ert--run-test-internal." - (when (and (not (symbolp debugger)) ; only run on anonymous debugger - (memq error-symbol '(ert-test-failed ert-test-skipped))) - (funcall debugger 'error data))) - (defun ert--special-operator-p (thing) "Return non-nil if THING is a symbol naming a special operator." (and (symbolp thing) @@ -319,8 +311,7 @@ ert--expand-should-1 (default-value (gensym "ert-form-evaluation-aborted-"))) `(let* ((,fn (function ,fn-name)) (,args (condition-case err - (let ((signal-hook-function #'ert--should-signal-hook)) - (list ,@arg-forms)) + (list ,@arg-forms) (error (progn (setq ,fn #'signal) (list (car err) (cdr err))))))) @@ -658,7 +649,7 @@ ert--infos ;;; Facilities for running a single test. -(defvar ert-debug-on-error nil +(define-obsolete-variable-alias 'ert-debug-on-error 'debug-on-error "27.1" "Non-nil means enter debugger when a test fails or terminates with an error.") ;; The data structures that represent the result of running a test. @@ -682,109 +673,68 @@ ert-debug-on-error ;; environment data needed during its execution. (cl-defstruct ert--test-execution-info (test (cl-assert nil)) - (result (cl-assert nil)) - ;; A thunk that may be called when RESULT has been set to its final - ;; value and test execution should be terminated. Should not - ;; return. - (exit-continuation (cl-assert nil)) - ;; The binding of `debugger' outside of the execution of the test. - next-debugger - ;; The binding of `ert-debug-on-error' that is in effect for the - ;; execution of the current test. We store it to avoid being - ;; affected by any new bindings the test itself may establish. (I - ;; don't remember whether this feature is important.) - ert-debug-on-error) - -(defun ert--run-test-debugger (info args) - "During a test run, `debugger' is bound to a closure that calls this function. - -This function records failures and errors and either terminates -the test silently or calls the interactive debugger, as -appropriate. + (result (cl-assert nil))) +(defun ert--store-backtrace (info error-symbol data) + "Record backtrace into INFO. INFO is the ert--test-execution-info corresponding to this test -run. ARGS are the arguments to `debugger'." - (cl-destructuring-bind (first-debugger-arg &rest more-debugger-args) - args - (cl-ecase first-debugger-arg - ((lambda debug t exit nil) - (apply (ert--test-execution-info-next-debugger info) args)) - (error - (let* ((condition (car more-debugger-args)) - (type (cl-case (car condition) - ((quit) 'quit) - ((ert-test-skipped) 'skipped) - (otherwise 'failed))) - ;; We store the backtrace in the result object for - ;; `ert-results-pop-to-backtrace-for-test-at-point'. - ;; This means we have to limit `print-level' and - ;; `print-length' when printing result objects. That - ;; might not be worth while when we can also use - ;; `ert-results-rerun-test-debugging-errors-at-point', - ;; (i.e., when running interactively) but having the - ;; backtrace ready for printing is important for batch - ;; use. - ;; - ;; Grab the frames above the debugger. - (backtrace (cdr (backtrace-get-frames debugger))) - (infos (reverse ert--infos))) - (setf (ert--test-execution-info-result info) - (cl-ecase type - (quit - (make-ert-test-quit :condition condition - :backtrace backtrace - :infos infos)) - (skipped - (make-ert-test-skipped :condition condition - :backtrace backtrace - :infos infos)) - (failed - (make-ert-test-failed :condition condition - :backtrace backtrace - :infos infos)))) - ;; Work around Emacs's heuristic (in eval.c) for detecting - ;; errors in the debugger. - (cl-incf num-nonmacro-input-events) - ;; FIXME: We should probably implement more fine-grained - ;; control a la non-t `debug-on-error' here. - (cond - ((ert--test-execution-info-ert-debug-on-error info) - (apply (ert--test-execution-info-next-debugger info) args)) - (t)) - (funcall (ert--test-execution-info-exit-continuation info))))))) +run. ERROR-SYMBOL and DATA are the same as for `signal'." + (let* (;; We store the backtrace in the result object for + ;; `ert-results-pop-to-backtrace-for-test-at-point'. + ;; This means we have to limit `print-level' and + ;; `print-length' when printing result objects. That + ;; might not be worth while when we can also use + ;; `ert-results-rerun-test-debugging-errors-at-point', + ;; (i.e., when running interactively) but having the + ;; backtrace ready for printing is important for batch + ;; use. + ;; + ;; Drop frames starting from the closure which calls this + ;; function (see lambda in `ert--run-test-internal'). + (backtrace (cddr (backtrace-get-frames #'ert--store-backtrace))) + (condition (cons error-symbol data)) + (infos (reverse ert--infos))) + (setf (ert--test-execution-info-result info) + (cl-case error-symbol + ((quit) + (make-ert-test-quit :condition condition + :backtrace backtrace + :infos infos)) + ((ert-test-skipped) + (make-ert-test-skipped :condition condition + :backtrace backtrace + :infos infos)) + (otherwise + (make-ert-test-failed :condition condition + :backtrace backtrace + :infos infos)))))) (defun ert--run-test-internal (test-execution-info) "Low-level function to run a test according to TEST-EXECUTION-INFO. This mainly sets up debugger-related bindings." - (setf (ert--test-execution-info-next-debugger test-execution-info) debugger - (ert--test-execution-info-ert-debug-on-error test-execution-info) - ert-debug-on-error) - (catch 'ert--pass - ;; For now, each test gets its own temp buffer and its own - ;; window excursion, just to be safe. If this turns out to be - ;; too expensive, we can remove it. - (with-temp-buffer - (save-window-excursion - ;; FIXME: Use `signal-hook-function' instead of `debugger' to - ;; handle ert errors. Once that's done, remove - ;; `ert--should-signal-hook'. See Bug#24402 and Bug#11218 for - ;; details. - (let ((debugger (lambda (&rest args) - (ert--run-test-debugger test-execution-info - args))) - (debug-on-error t) - (debug-on-quit t) - ;; FIXME: Do we need to store the old binding of this - ;; and consider it in `ert--run-test-debugger'? - (debug-ignored-errors nil) - (ert--infos '())) - (funcall (ert-test-body (ert--test-execution-info-test - test-execution-info)))))) - (ert-pass)) - (setf (ert--test-execution-info-result test-execution-info) - (make-ert-test-passed)) - nil) + (condition-case-unless-debug () + (progn + (catch 'ert--pass + ;; For now, each test gets its own temp buffer and its own + ;; window excursion, just to be safe. If this turns out to be + ;; too expensive, we can remove it. + (with-temp-buffer + (save-window-excursion + (let ((signal-hook-function + (lambda (errsym errdata) + ;; Rebind `signal-hook-function' to avoid + ;; accidental recursion. + (let ((signal-hook-function nil)) + (ert--store-backtrace test-execution-info + errsym errdata)))) + (ert--infos '())) + (funcall (ert-test-body (ert--test-execution-info-test + test-execution-info)))))) + (ert-pass)) + (setf (ert--test-execution-info-result test-execution-info) + (make-ert-test-passed))) + (t nil))) (defun ert--force-message-log-buffer-truncation () "Immediately truncate *Messages* buffer according to `message-log-max'. @@ -822,35 +772,32 @@ ert-run-test Returns the result and stores it in ERT-TEST's `most-recent-result' slot." (setf (ert-test-most-recent-result ert-test) nil) - (cl-block error - (let ((begin-marker - (with-current-buffer (messages-buffer) - (point-max-marker)))) - (unwind-protect - (let ((info (make-ert--test-execution-info - :test ert-test - :result - (make-ert-test-aborted-with-non-local-exit) - :exit-continuation (lambda () - (cl-return-from error nil)))) - (should-form-accu (list))) - (unwind-protect - (let ((ert--should-execution-observer - (lambda (form-description) - (push form-description should-form-accu))) - (message-log-max t) - (ert--running-tests (cons ert-test ert--running-tests))) - (ert--run-test-internal info)) - (let ((result (ert--test-execution-info-result info))) - (setf (ert-test-result-messages result) - (with-current-buffer (messages-buffer) - (buffer-substring begin-marker (point-max)))) - (ert--force-message-log-buffer-truncation) - (setq should-form-accu (nreverse should-form-accu)) - (setf (ert-test-result-should-forms result) - should-form-accu) - (setf (ert-test-most-recent-result ert-test) result)))) - (set-marker begin-marker nil)))) + (let ((begin-marker + (with-current-buffer (messages-buffer) + (point-max-marker)))) + (unwind-protect + (let ((info (make-ert--test-execution-info + :test ert-test + :result + (make-ert-test-aborted-with-non-local-exit))) + (should-form-accu (list))) + (unwind-protect + (let ((ert--should-execution-observer + (lambda (form-description) + (push form-description should-form-accu))) + (message-log-max t) + (ert--running-tests (cons ert-test ert--running-tests))) + (ert--run-test-internal info)) + (let ((result (ert--test-execution-info-result info))) + (setf (ert-test-result-messages result) + (with-current-buffer (messages-buffer) + (buffer-substring begin-marker (point-max)))) + (ert--force-message-log-buffer-truncation) + (setq should-form-accu (nreverse should-form-accu)) + (setf (ert-test-result-should-forms result) + should-form-accu) + (setf (ert-test-most-recent-result ert-test) result)))) + (set-marker begin-marker nil))) (ert-test-most-recent-result ert-test)) (defun ert-running-test () @@ -2424,11 +2371,10 @@ ert-results-rerun-test-at-point (goto-char point)))))) (defun ert-results-rerun-test-at-point-debugging-errors () - "Re-run the test at point with `ert-debug-on-error' bound to t. - + "Re-run the test at point with `debug-on-error' bound to t. To be used in the ERT results buffer." (interactive) - (let ((ert-debug-on-error t)) + (let ((debug-on-error t)) (ert-results-rerun-test-at-point))) (defun ert-results-pop-to-backtrace-for-test-at-point () diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 1fe5b79ef3..ac516135ca 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -85,7 +85,7 @@ ert-self-test-and-exit (ert-deftest ert-test-fail () (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (let ((result (let ((ert-debug-on-error nil)) + (let ((result (let ((debug-on-error nil)) (ert-run-test test)))) (cl-assert (ert-test-failed-p result) t) (cl-assert (equal (ert-test-result-with-condition-condition result) @@ -94,51 +94,29 @@ ert-self-test-and-exit (ert-deftest ert-test-fail-debug-with-condition-case () (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (condition-case condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (cl-assert (equal condition '(ert-test-failed "failure message")) t))))) + (should (equal (ert-test-result-with-condition-condition + (let ((debug-on-error t)) + (ert-run-test test))) + '(ert-test-failed "failure message"))))) (ert-deftest ert-test-fail-debug-with-debugger-1 () - (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (let ((debugger (lambda (&rest _args) - (cl-assert nil)))) - (let ((ert-debug-on-error nil)) - (ert-run-test test))))) + (let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))) + (debugger (lambda (&rest _) (cl-assert nil))) + (debug-on-error nil)) + (ert-run-test test))) (ert-deftest ert-test-fail-debug-with-debugger-2 () (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) (cl-block nil (let ((debugger (lambda (&rest _args) - (cl-return-from nil nil)))) - (let ((ert-debug-on-error t)) - (ert-run-test test)) + (cl-return-from nil nil))) + (debug-on-error t)) + (ert-run-test test) (cl-assert nil))))) -(ert-deftest ert-test-fail-debug-nested-with-debugger () - (let ((test (make-ert-test :body (lambda () - (let ((ert-debug-on-error t)) - (ert-fail "failure message")))))) - (let ((debugger (lambda (&rest _args) - (cl-assert nil nil "Assertion a")))) - (let ((ert-debug-on-error nil)) - (ert-run-test test)))) - (let ((test (make-ert-test :body (lambda () - (let ((ert-debug-on-error nil)) - (ert-fail "failure message")))))) - (cl-block nil - (let ((debugger (lambda (&rest _args) - (cl-return-from nil nil)))) - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil nil "Assertion b"))))) - (ert-deftest ert-test-error () (let ((test (make-ert-test :body (lambda () (error "Error message"))))) - (let ((result (let ((ert-debug-on-error nil)) + (let ((result (let ((debug-on-error nil)) (ert-run-test test)))) (cl-assert (ert-test-failed-p result) t) (cl-assert (equal (ert-test-result-with-condition-condition result) @@ -147,19 +125,18 @@ ert-self-test-and-exit (ert-deftest ert-test-error-debug () (let ((test (make-ert-test :body (lambda () (error "Error message"))))) - (condition-case condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (cl-assert (equal condition '(error "Error message")) t))))) + (let ((debug-on-error t) + (debugger #'ignore)) ; Don't print backtrace. + (should + (equal (ert-test-result-with-condition-condition + (ert-run-test test)) + '(error "Error message")))))) ;;; Test that `should' works. (ert-deftest ert-test-should () (let ((test (make-ert-test :body (lambda () (should nil))))) - (let ((result (let ((ert-debug-on-error nil)) + (let ((result (let ((debug-on-error nil)) (ert-run-test test)))) (cl-assert (ert-test-failed-p result) t) (cl-assert (equal (ert-test-result-with-condition-condition result) @@ -175,7 +152,7 @@ ert-self-test-and-exit (ert-deftest ert-test-should-not () (let ((test (make-ert-test :body (lambda () (should-not t))))) - (let ((result (let ((ert-debug-on-error nil)) + (let ((result (let ((debug-on-error nil)) (ert-run-test test)))) (cl-assert (ert-test-failed-p result) t) (cl-assert (equal (ert-test-result-with-condition-condition result) @@ -190,7 +167,7 @@ ert-self-test-and-exit (let ((test (make-ert-test :body (lambda () (cl-macrolet ((foo () `(progn t nil))) (should (foo))))))) - (let ((result (let ((ert-debug-on-error nil)) + (let ((result (let ((debug-on-error nil)) (ert-run-test test)))) (should (ert-test-failed-p result)) (should (equal @@ -202,7 +179,7 @@ ert-self-test-and-exit (ert-deftest ert-test-should-error () ;; No error. (let ((test (make-ert-test :body (lambda () (should-error (progn)))))) - (let ((result (let ((ert-debug-on-error nil)) + (let ((result (let ((debug-on-error nil)) (ert-run-test test)))) (should (ert-test-failed-p result)) (should (equal (ert-test-result-with-condition-condition result) @@ -345,13 +322,23 @@ ert--test-my-list (error "Foo"))) do (let ((test (make-ert-test :body body))) - (condition-case actual-condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (should (equal actual-condition expected-condition))))))) + (should (equal (ert-test-result-with-condition-condition + (let ((debug-on-error nil)) + (ert-run-test test))) + expected-condition))))) + +(ert-deftest ert-nested-should () + "Test (dynamically) nested `should' forms (Bug#30745)." + (let ((test (make-ert-test :body (lambda () (should (eq 1 2)))))) + (should (equal (ert-test-result-with-condition-condition + (ert-run-test test)) + '(ert-test-failed + ((should (eq 1 2)) :form (eq 1 2) :value nil)))))) + +(ert-deftest ert-with-demoted-errors () + "An error which is caught shouldn't fail the test (Bug#11218)." + (should (progn (with-demoted-errors (error "error!")) + t))) (defun ert-test--which-file () "Dummy function to help test `symbol-file' for tests.") @@ -518,7 +505,7 @@ ert-test--which-file (skipped-test (make-ert-test :name 'skipped-test :body (lambda () (ert-skip "skip message"))))) - (let ((ert-debug-on-error nil)) + (let ((debug-on-error nil)) (let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*")) (messages nil) (mock-message-fn @@ -566,7 +553,7 @@ ert-test--which-file (should (null '())) (should nil) (should t))))) - (let ((result (let ((ert-debug-on-error nil)) + (let ((result (let ((debug-on-error nil)) (ert-run-test test)))) (should (equal (ert-test-result-should-forms result) '(((should t) :form t :value t) @@ -581,7 +568,7 @@ ert-test--which-file (should t))))) (let ((result (ert-run-test test2))) (should (ert-test-passed-p result)))))))) - (let ((result (let ((ert-debug-on-error nil)) + (let ((result (let ((debug-on-error nil)) (ert-run-test test)))) (should (ert-test-passed-p result)) (should (eql (length (ert-test-result-should-forms result)) @@ -593,7 +580,7 @@ ert-test--which-file (should (equal obj '(a))) (setf (car obj) 'b) (should (equal obj '(b)))))))) - (let ((result (let ((ert-debug-on-error nil)) + (let ((result (let ((debug-on-error nil)) (ert-run-test test)))) (should (ert-test-passed-p result)) (should (equal (ert-test-result-should-forms result) diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index 9798f0c824..16b4751a38 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -114,7 +114,7 @@ ert--hash-table-to-alist (skipped-test (make-ert-test :name 'skipped-test :body (lambda () (ert-skip "skip message")))) - (ert-debug-on-error nil) + (debug-on-error nil) (buffer-name (generate-new-buffer-name "*ert-test-run-tests*")) (messages nil) (mock-message-fn -- 2.11.0 --=-=-= Content-Type: text/plain But it bumps into another bug lurking in process.c, which just happened to work okay previously because ert would bind debug-on-error while running tests. There is only one test in the Emacs test suite which triggers this, we can work around it by binding debug-on-error there: --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=v1-0002-Work-around-should-error-.-accept-process-output-.patch Content-Description: patch >From d586f0e4e0ec057be047b13aea53a05009ece3cf Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Tue, 14 Aug 2018 20:21:26 -0400 Subject: [PATCH v1 2/3] Work around (should-error ... accept-process-output) bug This is needed to let the test `json-el-cant-serialize-this' pass with the previous change. That test expects a signal to propogate up from accept-process-output. This did happen previously because ert used to bind `debug-on-error' while running, but since the previous change it no longer does so. The function read_and_dispose_of_process_output would catch errors if `debug-on-error' is nil. * test/lisp/jsonrpc-tests.el (json-el-cant-serialize-this): Let-bind debug-on-error around the should-error body. --- test/lisp/jsonrpc-tests.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el index 1a84c30e33..f541c67313 100644 --- a/test/lisp/jsonrpc-tests.el +++ b/test/lisp/jsonrpc-tests.el @@ -152,11 +152,16 @@ jsonrpc--call-with-emacsrpc-fixture (ert-deftest json-el-cant-serialize-this () "Can't serialize a response that is half-vector/half-list." + ;; We need to let-bind `debug-on-error' due a bug in + ;; read_and_dispose_of_process_output of process.c, which would + ;; otherwise catch errors (see the FIXME on the + ;; internal_condition_case_1 call). (jsonrpc--with-emacsrpc-fixture (conn) (should-error ;; (append [1 2 3] [3 4 5]) => (1 2 3 . [3 4 5]), which can't be - ;; serialized - (jsonrpc-request conn 'append [[1 2 3] [3 4 5]])))) + ;; serialized. + (let ((debug-on-error t)) + (jsonrpc-request conn 'append [[1 2 3] [3 4 5]]))))) (cl-defmethod jsonrpc-connection-ready-p ((conn jsonrpc--test-client) what) -- 2.11.0 --=-=-= Content-Type: text/plain This third patch is not really needed to fix the bug, but I had to simplify the code in order to figure out what was going on anyway. --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=v1-0003-Simplify-ert-should-expansion-macro-machinery.patch Content-Description: patch >From 3dc99ded842532056f5590d551f42f01024104ca Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Mon, 13 Aug 2018 22:22:43 -0400 Subject: [PATCH v1 3/3] Simplify ert `should'-expansion macro machinery * lisp/emacs-lisp/ert.el (ert--should-execution-observer): Default to `ignore'. (ert--signal-should-execution): Now we don't need to check if ert--should-execution-observer is nil. (ert--last-should-execution): New function. (ert--special-operator-p): Remove, replace usage with special-form-p. (ert--do-form): New function. (ert--expand-should, ert--expand-should-1): Coalesce, remove the latter. (should, should-not, should-error, ert--skip-unless): Simplify accordingly. (ert-run-test): Adjust `ert--should-execution-observer' to make `ert--last-should-execution' work. * test/lisp/emacs-lisp/ert-tests.el (ert-test-special-operator-p): Move to... * test/lisp/subr-tests.el (special-form-p): ...here. --- lisp/emacs-lisp/ert.el | 185 ++++++++++++++------------------------ test/lisp/emacs-lisp/ert-tests.el | 9 -- test/lisp/subr-tests.el | 9 ++ 3 files changed, 77 insertions(+), 126 deletions(-) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 09b0240c90..d91d64a885 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -259,24 +259,39 @@ ert-skip ;;; The `should' macros. -(defvar ert--should-execution-observer nil) +(defvar ert--should-execution-observer #'ignore) (defun ert--signal-should-execution (form-description) - "Tell the current `should' form observer (if any) about FORM-DESCRIPTION." - (when ert--should-execution-observer - (funcall ert--should-execution-observer form-description))) - -(defun ert--special-operator-p (thing) - "Return non-nil if THING is a symbol naming a special operator." - (and (symbolp thing) - (let ((definition (indirect-function thing))) - (and (subrp definition) - (eql (cdr (subr-arity definition)) 'unevalled))))) - -;; FIXME: Code inside of here should probably be evaluated like it is -;; outside of tests, with the sole exception of error handling -(defun ert--expand-should-1 (whole form inner-expander) - "Helper function for the `should' macro and its variants." + "Tell the current `should' form observer about FORM-DESCRIPTION." + (funcall ert--should-execution-observer form-description)) + +(defun ert--last-should-execution () + "Ask the `should' form observer for the last FORM-DESCRIPTION." + (funcall ert--should-execution-observer)) + +(defun ert--do-form (whole form-args-fun form-fun &optional fn-name) + "Helper function, used in `ert-expand-should' output." + (let ((form-desc (list whole))) + (unwind-protect + (let ((args (funcall form-args-fun))) + (cl-callf nconc form-desc (list :form (if fn-name + (cons fn-name args) + args))) + (let ((val (apply form-fun (and (listp args) args)))) + (cl-callf nconc form-desc + (list :value val) + (let ((explainer (and (symbolp fn-name) + (get fn-name 'ert-explainer)))) + (when explainer + (list :explanation (apply explainer args))))) + val)) + (ert--signal-should-execution form-desc)))) + +(defun ert--expand-should (whole form) + "Helper function for the `should' macro and its variants. +Analyzes FORM and returns an expression that has the same +semantics under evaluation but records additional debugging +information." (let ((form ;; catch macroexpansion errors (condition-case err @@ -290,94 +305,39 @@ ert--expand-should-1 cl-macro-environment)))) (error `(signal ',(car err) ',(cdr err)))))) (cond - ((or (atom form) (ert--special-operator-p (car form))) - (let ((value (gensym "value-"))) - `(let ((,value (gensym "ert-form-evaluation-aborted-"))) - ,(funcall inner-expander - `(setq ,value ,form) - `(list ',whole :form ',form :value ,value) - value) - ,value))) + ((atom form) + `(ert--do-form ',whole + (lambda () ',form) + (lambda (&rest _) ,form))) + ((special-form-p (car form)) + `(ert--do-form ',whole + (lambda () ',(cdr form)) + (lambda (&rest _) ,form) + ',(car form))) (t (let ((fn-name (car form)) (arg-forms (cdr form))) - (cl-assert (or (symbolp fn-name) - (and (consp fn-name) - (eql (car fn-name) 'lambda) - (listp (cdr fn-name))))) - (let ((fn (gensym "fn-")) - (args (gensym "args-")) - (value (gensym "value-")) - (default-value (gensym "ert-form-evaluation-aborted-"))) - `(let* ((,fn (function ,fn-name)) - (,args (condition-case err - (list ,@arg-forms) - (error (progn (setq ,fn #'signal) - (list (car err) - (cdr err))))))) - (let ((,value ',default-value)) - ,(funcall inner-expander - `(setq ,value (apply ,fn ,args)) - `(nconc (list ',whole) - (list :form `(,,fn ,@,args)) - (unless (eql ,value ',default-value) - (list :value ,value)) - (let ((-explainer- - (and (symbolp ',fn-name) - (get ',fn-name 'ert-explainer)))) - (when -explainer- - (list :explanation - (apply -explainer- ,args))))) - value) - ,value)))))))) - -(defun ert--expand-should (whole form inner-expander) - "Helper function for the `should' macro and its variants. - -Analyzes FORM and returns an expression that has the same -semantics under evaluation but records additional debugging -information. - -INNER-EXPANDER should be a function and is called with two -arguments: INNER-FORM and FORM-DESCRIPTION-FORM, where INNER-FORM -is an expression equivalent to FORM, and FORM-DESCRIPTION-FORM is -an expression that returns a description of FORM. INNER-EXPANDER -should return code that calls INNER-FORM and performs the checks -and error signaling specific to the particular variant of -`should'. The code that INNER-EXPANDER returns must not call -FORM-DESCRIPTION-FORM before it has called INNER-FORM." - (ert--expand-should-1 - whole form - (lambda (inner-form form-description-form value-var) - (let ((form-description (gensym "form-description-"))) - `(let (,form-description) - ,(funcall inner-expander - `(unwind-protect - ,inner-form - (setq ,form-description ,form-description-form) - (ert--signal-should-execution ,form-description)) - `,form-description - value-var)))))) + (cl-assert (or (symbolp fn-name) (functionp fn-name))) + `(ert--do-form ',whole + (lambda () (list ,@arg-forms)) + #',fn-name + #',fn-name)))))) (cl-defmacro should (form) "Evaluate FORM. If it returns nil, abort the current test as failed. Returns the value of FORM." (declare (debug t)) - (ert--expand-should `(should ,form) form - (lambda (inner-form form-description-form _value-var) - `(unless ,inner-form - (ert-fail ,form-description-form))))) + `(or ,(ert--expand-should `(should ,form) form) + (ert-fail (ert--last-should-execution)))) (cl-defmacro should-not (form) "Evaluate FORM. If it returns non-nil, abort the current test as failed. Returns nil." (declare (debug t)) - (ert--expand-should `(should-not ,form) form - (lambda (inner-form form-description-form _value-var) - `(unless (not ,inner-form) - (ert-fail ,form-description-form))))) + `(and ,(ert--expand-should `(should-not ,form) form) + (ert-fail (ert--last-should-execution)))) (defun ert--should-error-handle-error (form-description-fn condition type exclude-subtypes) @@ -423,37 +383,26 @@ ert--should-error-handle-error failed." (declare (debug t)) (unless type (setq type ''error)) - (ert--expand-should - `(should-error ,form ,@keys) - form - (lambda (inner-form form-description-form value-var) - (let ((errorp (gensym "errorp")) - (form-description-fn (gensym "form-description-fn-"))) - `(let ((,errorp nil) - (,form-description-fn (lambda () ,form-description-form))) - (condition-case -condition- - ,inner-form - ;; We can't use ,type here because we want to evaluate it. - (error - (setq ,errorp t) - (ert--should-error-handle-error ,form-description-fn - -condition- - ,type ,exclude-subtypes) - (setq ,value-var -condition-))) - (unless ,errorp - (ert-fail (append - (funcall ,form-description-fn) - (list - :fail-reason "did not signal an error"))))))))) + `(or (condition-case -condition- + (progn ,(ert--expand-should `(should-error ,form ,@keys) form) + nil) + ;; We can't use ,TYPE here because we want to evaluate it. + (error + (ert--should-error-handle-error #'ert--last-should-execution + -condition- + ,type ,exclude-subtypes) + -condition-)) + (ert-fail (append + (ert--last-should-execution) + (list + :fail-reason "did not signal an error"))))) (cl-defmacro ert--skip-unless (form) "Evaluate FORM. If it returns nil, skip the current test. Errors during evaluation are caught and handled like nil." (declare (debug t)) - (ert--expand-should `(skip-unless ,form) form - (lambda (inner-form form-description-form _value-var) - `(unless (ignore-errors ,inner-form) - (ert-skip ,form-description-form))))) + `(or (ignore-errors ,(ert--expand-should `(skip-unless ,form) form)) + (ert-skip (ert--last-should-execution)))) ;;; Explanation of `should' failures. @@ -783,8 +732,10 @@ ert-run-test (should-form-accu (list))) (unwind-protect (let ((ert--should-execution-observer - (lambda (form-description) - (push form-description should-form-accu))) + (lambda (&optional form-description) + (if form-description + (push form-description should-form-accu) + (car should-form-accu)))) (message-log-max t) (ert--running-tests (cons ert-test ert--running-tests))) (ert--run-test-internal info)) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index ac516135ca..12ff4c040a 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -538,15 +538,6 @@ ert-test--which-file (when (get-buffer buffer-name) (kill-buffer buffer-name)))))))) -(ert-deftest ert-test-special-operator-p () - (should (ert--special-operator-p 'if)) - (should-not (ert--special-operator-p 'car)) - (should-not (ert--special-operator-p 'ert--special-operator-p)) - (let ((b (cl-gensym))) - (should-not (ert--special-operator-p b)) - (fset b 'if) - (should (ert--special-operator-p b)))) - (ert-deftest ert-test-list-of-should-forms () (let ((test (make-ert-test :body (lambda () (should t) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 86938d5dbe..fbdcf70560 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -360,5 +360,14 @@ subr-test--frames-1 (shell-quote-argument "%ca%"))) "without-caret %ca%")))) +(ert-deftest special-form-p () + (should (special-form-p 'if)) + (should-not (special-form-p 'car)) + (should-not (special-form-p 'special-form-p)) + (let ((b (gensym))) + (should-not (special-form-p b)) + (fset b 'if) + (should (special-form-p b)))) + (provide 'subr-tests) ;;; subr-tests.el ends here -- 2.11.0 --=-=-=-- From unknown Fri Sep 05 20:54:50 2025 X-Loop: help-debbugs@gnu.org Subject: bug#24618: 26.0.50; `condition-case' doesn't allow catching all signals Resent-From: Noam Postavsky Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 04 Sep 2018 23:07:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 24618 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Philipp Stephani Cc: 24618@debbugs.gnu.org Received: via spool by 24618-submit@debbugs.gnu.org id=B24618.1536102372338 (code B ref 24618); Tue, 04 Sep 2018 23:07:02 +0000 Received: (at 24618) by debbugs.gnu.org; 4 Sep 2018 23:06:12 +0000 Received: from localhost ([127.0.0.1]:46117 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fxKOi-00005I-HE for submit@debbugs.gnu.org; Tue, 04 Sep 2018 19:06:12 -0400 Received: from mail-it0-f48.google.com ([209.85.214.48]:56027) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fxKOg-00004u-EK; Tue, 04 Sep 2018 19:06:10 -0400 Received: by mail-it0-f48.google.com with SMTP id d10-v6so7376478itj.5; Tue, 04 Sep 2018 16:06:10 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=3mXXc5JAiYwNfjO8kBeKA31l42cVHKOd3EVB5s3vdHc=; b=Z+BwYwtZNjYNKVlsyjwxD1kdKNfplqLUyr3fZ+tmCthecN95+DLQpRtVi+fNJg52R4 wlX1wVG/rzI77w6ubi9V67cg1xc44aFSQPxUys0iKDmUO99JWvxTEgitZnoE3QkkDxeJ dGWxzSFhRMgDuk/leHJneA/DSWjZ7GgCpUMnojZ50/eEjRxPldgcrdddpULin6eDXv/C 6Uifpstn3dokAUuXATenmP9oZKVrqlP8zIRMB11LF/noywtlHnxx7OTvkO9kco2qca90 i9fcxKvXvdkW/vXCKJWH9dmtkfIo2JrICN3K2wLyu1b1W4+bSq+emhvwLcm0klEuKYAH bx4w== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=3mXXc5JAiYwNfjO8kBeKA31l42cVHKOd3EVB5s3vdHc=; b=UVmlJgDiJHm+PgJTuozBzVa61Gy2cjUWzcMNa7+0pycVwhBWsu0wjyFZVoyCz3TH7g 2qAnzOaM0puOOZSXDd4Iu4upLkZuowMNdXlhuzBzQ4kplyZv8Qqh3wYXTXBfRFW7eysb RuIUBaOTZ4Y5Qijx3IU0JV4sI2fxuBQhMky4LolLnj5zHAZGAmcp7Once8hYSWdTrjwR AIh/n1md/Hc5C2In2SybojxnRQQMuf/ThH/IkwPBh+o07Q8fqagimVbKzAuEGS5nVGdo t+/q9rbrNiSduOjoN/GZasEfkc6kU0dkL6XfHvnH9imFQlVTukSE7upXer6w29h00oiN 9yTQ== X-Gm-Message-State: APzg51CmdIev4+V04v7aDWdUNDEJFotmrPljdIOzWNZe/5QhKL8fz+DW to/ax00XjRsjnF8f1WNVgVSWRtXi X-Google-Smtp-Source: ANB0VdaLTOJled0No4jkJ7nHrFyirWqQ2UkzXJmXIHj+ESjSQpXtHZrAYPb7AP/z2Sud9hNlQakRPg== X-Received: by 2002:a24:9301:: with SMTP id y1-v6mr1885925itd.29.1536102364855; Tue, 04 Sep 2018 16:06:04 -0700 (PDT) Received: from zebian (cbl-45-2-119-34.yyz.frontiernetworks.ca. [45.2.119.34]) by smtp.googlemail.com with ESMTPSA id z193-v6sm82721ioe.78.2018.09.04.16.06.03 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 04 Sep 2018 16:06:03 -0700 (PDT) From: Noam Postavsky References: Date: Tue, 04 Sep 2018 19:06:03 -0400 In-Reply-To: (Philipp Stephani's message of "Tue, 04 Oct 2016 18:42:27 +0200") Message-ID: <87sh2ohnhg.fsf@gmail.com> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.1 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) tags 24618 fixed close 24618 27.1 quit Philipp Stephani writes: > Consider the following code: > > (condition-case err > (signal 'does-not-exist '(1 2)) > (error (print err))) > > The signal is not caught by condition-case because it has no error > conditions. This makes it impossible to reliably catch all signals > (without abusing the debugger). I propose that an error condition of > 't' in `condition-case' should be interpreted as 'all conditions'. Done in master. [1: 425c281164]: 2018-09-04 18:50:15 -0400 Allow t as a catch-all condition-case handler (Bug#24618) https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=425c2811641a6b8ec4549cad5f6bd15a46bc95d5