GNU logs - #30745, boring messages

Message sent to bug-gnu-emacs@HIDDEN:

Subject: bug#30745: 26.0.91; ert should macros nest strangely
Resent-From: phillip.lord@HIDDEN (Phillip Lord)
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Wed, 07 Mar 2018 21:36:01 +0000
Resent-Message-ID: <handler.30745.B.152045852015752 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: 30745 <at> debbugs.gnu.org
From: phillip.lord@HIDDEN (Phillip Lord)
Date: Wed, 07 Mar 2018 21:34:22 +0000
Message-ID: <874llr4lk1.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.91 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain
Precedence: list
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>


ert should macros seem to behave strangely when nested.

Consider the following reproduction:

(require 'cl-lib)
(require 'ert)

(princ
 (cl-cdadr
  (ert-test-result-with-condition-condition
   (ert-run-test
    (make-ert-test
     :body
     (lambda () (should (eq 1 2))))))))

(princ "\nSecond test\n")

(princ
 (should
  (equal
   (cl-cdadr
    (ert-test-result-with-condition-condition
     (ert-run-test
      (make-ert-test
       :body
       (lambda () (should (eq 1 2)))))))
   '(:form (eq 1 2) :value nil))))

(princ "\n")

In Emacs-25 the following behaviour is seen when running this in batch.

~/src/git/emacs-git/emacs-25$ ./src/emacs --batch -l temp.el
(:form (eq 1 2) :value nil)
Second test
t


In Emacs-26, however, we get a different behaviour:


~/src/git/emacs-git/emacs-26$ ./phil_emacs.sh 
(:form (eq 1 2) :value nil)
Second test
Test failed: ((should (equal (cl-cdadr (ert-test-result-with-condition-condition (ert-run-test (make-ert-test :body (lambda nil (should (eq 1 2))))))) (quote (:form (eq 1 2) :value nil)))) :form (equal nil (:form (eq 1 2) :value nil)) :value nil :explanation (different-types nil (:form (eq 1 2) :value nil)))


So, although, the return type of this lot:

 (cl-cdadr
  (ert-test-result-with-condition-condition
   (ert-run-test
    (make-ert-test
     :body
     (lambda () (should (eq 1 2))))))))

remains the same between Emacs-25 and Emacs-26, a test for this breaks.

This regression is caused by:

commit 054c198c120c1f01a8ff753892d52710b740acc6

found by bisection. The regression continues on master.

I will try and find a simpler reproduction.

Message sent:

Content-Disposition: inline
Content-Transfer-Encoding: quoted-printable
MIME-Version: 1.0
X-Mailer: MIME-tools 5.505 (Entity 5.505)
Content-Type: text/plain; charset=utf-8
X-Loop: help-debbugs@HIDDEN
From: help-debbugs@HIDDEN (GNU bug Tracking System)
To: phillip.lord@HIDDEN (Phillip Lord)
Subject: bug#30745: Acknowledgement (26.0.91; ert should macros nest
 strangely)
Message-ID: <handler.30745.B.152045852015752.ack <at> debbugs.gnu.org>
References: <874llr4lk1.fsf@HIDDEN>
X-Gnu-PR-Message: ack 30745
X-Gnu-PR-Package: emacs
Reply-To: 30745 <at> debbugs.gnu.org
Date: Wed, 07 Mar 2018 21:36:02 +0000

Thank you for filing a new bug report with debbugs.gnu.org.

This is an automatically generated reply to let you know your message
has been received.

Your message is being forwarded to the package maintainers and other
interested parties for their attention; they will reply in due course.

Your message has been sent to the package maintainer(s):
 bug-gnu-emacs@HIDDEN

If you wish to submit further information on this problem, please
send it to 30745 <at> debbugs.gnu.org.

Please do not send mail to help-debbugs@HIDDEN unless you wish
to report a problem with the Bug-tracking system.

--=20
30745: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D30745
GNU Bug Tracking System
Contact help-debbugs@HIDDEN with problems

Message sent to bug-gnu-emacs@HIDDEN:

Subject: bug#30745: 26.0.91; ert should macros nest strangely
Resent-From: phillip.lord@HIDDEN (Phillip Lord)
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Wed, 07 Mar 2018 22:25:01 +0000
Resent-Message-ID: <handler.30745.B30745.152046148720803 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: 30745 <at> debbugs.gnu.org
From: phillip.lord@HIDDEN (Phillip Lord)
References: <874llr4lk1.fsf@HIDDEN>
Date: Wed, 07 Mar 2018 22:24:38 +0000
In-Reply-To: <874llr4lk1.fsf@HIDDEN> (Phillip Lord's message of "Wed,
 07 Mar 2018 21:34:22 +0000")
Message-ID: <87tvtr34nt.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.91 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain
Precedence: list
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>


This reproduction with a simpler test shows that the problem is nesting.

(require 'ert)

(defun simple-test ()
  (ert-test-result-with-condition-condition
   (ert-run-test
    (make-ert-test
     :body
     (lambda () (should (eq 1 2)))))))

(princ (simple-test))

(princ "\nAnd forcibly unnested\n")

(princ
 (let ((res (simple-test)))
   (should
    (equal
     '(ert-test-failed
       ((should (eq 1 2)) :form (eq 1 2) :value nil))
     res))))


(princ "\nAnd nested\n")

(princ
 (should
  (equal
   '(ert-test-failed
     ((should (eq 1 2)) :form (eq 1 2) :value nil))
   (simple-test))))

(princ "\n")


Emacs-25

(ert-test-failed ((should (eq 1 2)) :form (eq 1 2) :value nil))
And forcibly unnested
t
And nested
t


Emacs-26

(ert-test-failed ((should (eq 1 2)) :form (eq 1 2) :value nil))
And forcibly unnested
t
And nested
Test failed: ((should (equal (quote (ert-test-failed ((should (eq 1 2)) :form (eq 1 2) :value nil))) (simple-test))) :form (equal (ert-test-failed ((should (eq 1 2)) :form (eq 1 2) :value nil)) (((should (eq 1 2)) :form (eq 1 2) :value nil))) :value nil :explanation (proper-lists-of-different-length 2 1 (ert-test-failed ((should (eq 1 2)) :form (eq 1 2) :value nil)) (((should (eq 1 2)) :form (eq 1 2) :value nil)) first-mismatch-at 0))

Message sent to bug-gnu-emacs@HIDDEN:

Subject: bug#30745: 26.0.91; ert should macros nest strangely
Resent-From: Noam Postavsky <npostavs@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Thu, 08 Mar 2018 00:13:01 +0000
Resent-Message-ID: <handler.30745.B30745.152046793831295 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: phillip.lord@HIDDEN (Phillip Lord)
Cc: 30745 <at> debbugs.gnu.org
From: Noam Postavsky <npostavs@HIDDEN>
References: <874llr4lk1.fsf@HIDDEN>
Date: Wed, 07 Mar 2018 19:12:09 -0500
In-Reply-To: <874llr4lk1.fsf@HIDDEN> (Phillip Lord's message of "Wed,
 07 Mar 2018 21:34:22 +0000")
Message-ID: <87r2ov1l46.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.90 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain
Precedence: list
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>

phillip.lord@HIDDEN (Phillip Lord) writes:

> This regression is caused by:
>
> commit 054c198c120c1f01a8ff753892d52710b740acc6

Hmm, according to https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24402#56
we thought nesting should still have worked, but apparently that was too
optimistic.

Message sent to bug-gnu-emacs@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: bug#30745: 26.0.91; ert should macros nest strangely
Resent-From: phillip.lord@HIDDEN (Phillip Lord)
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Thu, 08 Mar 2018 08:55:02 +0000
Resent-Message-ID: <handler.30745.B30745.152049929027529 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 30745
X-GNU-PR-Package: emacs
X-GNU-PR-Keywords: 
To: Noam Postavsky <npostavs@HIDDEN>
Cc: 30745 <at> debbugs.gnu.org, 24402 <at> debbugs.gnu.org
Received: via spool by 30745-submit <at> debbugs.gnu.org id=B30745.152049929027529
          (code B ref 30745); Thu, 08 Mar 2018 08:55:02 +0000
Received: (at 30745) by debbugs.gnu.org; 8 Mar 2018 08:54:50 +0000
Received: from localhost ([127.0.0.1]:50164 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1etrK6-00079w-4y
	for submit <at> debbugs.gnu.org; Thu, 08 Mar 2018 03:54:50 -0500
Received: from cloud103.planethippo.com ([78.129.138.110]:49500)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <phillip.lord@HIDDEN>)
 id 1etrK4-00079f-8g; Thu, 08 Mar 2018 03:54:48 -0500
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed;
 d=russet.org.uk; s=default; h=Content-Type:MIME-Version:Message-ID:
 In-Reply-To:Date:References:Subject:Cc:To:From:Sender:Reply-To:
 Content-Transfer-Encoding:Content-ID:Content-Description:Resent-Date:
 Resent-From:Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID:List-Id:
 List-Help:List-Unsubscribe:List-Subscribe:List-Post:List-Owner:List-Archive;
 bh=H7mQm+3ua7BkvVRlDlf31eTH0jo8luU3dPfLhbkgepQ=; b=zeDlMFzjJN8DMCfSt33a5AcHj
 FzvM1n8uvyKNkZLcL6CNL4ng8M3oO0fq8G1iMcAAfEE0+GDyBdSYCKB7klGZJIMtdnP3oMaEhQP9Z
 0rulLTvA81+fDAFZp3Hi2yldGMLR6kPlfb6lT1rPW8JjJOoQV0jU9ONX7sFB11JNS8PBoDVWK+i+1
 AmFocEbuZrJOOrVzWD725JGYyklMhcOhsQCAJm2e65q9llBDvKKmsFCbnskqDS98McVbMA4NvDJUI
 E6xoH9wFkcV3LX/OwXZigt414iO5BOLXZXT1Rb4nT1p+bprHeQXFPmAmFc8QfPVPvKFeXuL02SOCy
 sr+Gf5tgw==;
Received: from cpc142652-benw12-2-0-cust953.16-2.cable.virginm.net
 ([82.21.43.186]:35400 helo=russet.org.uk)
 by cloud103.planethippo.com with esmtpsa
 (TLSv1.2:ECDHE-RSA-AES128-GCM-SHA256:128) (Exim 4.89_1)
 (envelope-from <phillip.lord@HIDDEN>)
 id 1etrJx-001RrA-By; Thu, 08 Mar 2018 08:54:41 +0000
From: phillip.lord@HIDDEN (Phillip Lord)
References: <874llr4lk1.fsf@HIDDEN> <87r2ov1l46.fsf@HIDDEN>
Date: Thu, 08 Mar 2018 08:54:41 +0000
In-Reply-To: <87r2ov1l46.fsf@HIDDEN> (Noam Postavsky's message of "Wed, 07
 Mar 2018 19:12:09 -0500")
Message-ID: <87sh9blzfy.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.91 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain
X-AntiAbuse: This header was added to track abuse,
 please include it with any abuse report
X-AntiAbuse: Primary Hostname - cloud103.planethippo.com
X-AntiAbuse: Original Domain - debbugs.gnu.org
X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12]
X-AntiAbuse: Sender Address Domain - russet.org.uk
X-Get-Message-Sender-Via: cloud103.planethippo.com: authenticated_id:
 phillip.lord@HIDDEN
X-Authenticated-Sender: cloud103.planethippo.com: phillip.lord@HIDDEN
X-Source: 
X-Source-Args: 
X-Source-Dir: 
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: 0.0 (/)

Noam Postavsky <npostavs@HIDDEN> writes:

> phillip.lord@HIDDEN (Phillip Lord) writes:
>
>> This regression is caused by:
>>
>> commit 054c198c120c1f01a8ff753892d52710b740acc6
>
> Hmm, according to https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24402#56
> we thought nesting should still have worked, but apparently that was too
> optimistic.


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.

Phil

Message sent to bug-gnu-emacs@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: bug#30745: 26.0.91; ert should macros nest strangely
Resent-From: phillip.lord@HIDDEN (Phillip Lord)
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Thu, 08 Mar 2018 14:50:03 +0000
Resent-Message-ID: <handler.30745.B30745.15205205813738 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 30745
X-GNU-PR-Package: emacs
X-GNU-PR-Keywords: 
To: 24402 <at> debbugs.gnu.org
Cc: 30745 <at> debbugs.gnu.org
Received: via spool by 30745-submit <at> debbugs.gnu.org id=B30745.15205205813738
          (code B ref 30745); Thu, 08 Mar 2018 14:50:03 +0000
Received: (at 30745) by debbugs.gnu.org; 8 Mar 2018 14:49:41 +0000
Received: from localhost ([127.0.0.1]:50394 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1etwrU-0000y8-P3
	for submit <at> debbugs.gnu.org; Thu, 08 Mar 2018 09:49:40 -0500
Received: from cloud103.planethippo.com ([78.129.138.110]:58308)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <phillip.lord@HIDDEN>)
 id 1etwrS-0000xl-82; Thu, 08 Mar 2018 09:49:38 -0500
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed;
 d=russet.org.uk; s=default; h=Content-Type:MIME-Version:References:Message-ID
 :Date:In-Reply-To:Subject:Cc:To:From:Sender:Reply-To:
 Content-Transfer-Encoding:Content-ID:Content-Description:Resent-Date:
 Resent-From:Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID:List-Id:
 List-Help:List-Unsubscribe:List-Subscribe:List-Post:List-Owner:List-Archive;
 bh=HNJMmzv7pxFy8vwGpH4XAVl0kaBu58ylJb8L5nINc38=; b=lXZ4dQFahrBt4azlziG0mf5y3
 Arcxu0srurDPUpXV+/KzttW/paof9F0O5vkz0TZVLPA8tM1s8M+PR8/kMAF9YBr9vH3SMHAWboYk1
 KICR8FFSngRA/OBPPU4nXCJD0Y+iaxQvDp3qcFHqJhpBdT3HNqwMJzKcgG75X4EogPvGjVd96luP5
 wyiZKG1M93AFxnFq14ZFJZU6fi5MRI1l73O58rNAo3OThIZbpSJ3seRHIuq4Py7rsgaJUWy/vrIwv
 dv/zv2DHGowCi/LEIrFT5sWSOZuqyRkoAWce3SdwVTlFH/+EASlUD6FG7wMCiY6dZFKg6WtGZ+Uht
 3gHdkpWUw==;
Received: from cpc142652-benw12-2-0-cust953.16-2.cable.virginm.net
 ([82.21.43.186]:38534 helo=russet.org.uk)
 by cloud103.planethippo.com with esmtpsa
 (TLSv1.2:ECDHE-RSA-AES128-GCM-SHA256:128) (Exim 4.89_1)
 (envelope-from <phillip.lord@HIDDEN>)
 id 1etwrL-001pyC-55; Thu, 08 Mar 2018 14:49:31 +0000
From: phillip.lord@HIDDEN (Phillip Lord)
In-Reply-To: <87tvtr34nt.fsf@HIDDEN> (Phillip Lord's message of "Wed,
 07 Mar 2018 22:24:38 +0000")
Date: Thu, 08 Mar 2018 14:49:27 +0000
Message-ID: <877eqmpqq0.fsf@HIDDEN>
References: <874llr4lk1.fsf@HIDDEN> <87tvtr34nt.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.91 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain
X-AntiAbuse: This header was added to track abuse,
 please include it with any abuse report
X-AntiAbuse: Primary Hostname - cloud103.planethippo.com
X-AntiAbuse: Original Domain - debbugs.gnu.org
X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12]
X-AntiAbuse: Sender Address Domain - russet.org.uk
X-Get-Message-Sender-Via: cloud103.planethippo.com: authenticated_id:
 phillip.lord@HIDDEN
X-Authenticated-Sender: cloud103.planethippo.com: phillip.lord@HIDDEN
X-Source: 
X-Source-Args: 
X-Source-Dir: 
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: 0.0 (/)


Just noting that the fix for this bug has caused a regression.

Message sent to bug-gnu-emacs@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: bug#30745: 26.0.91; ert should macros nest strangely
Resent-From: Noam Postavsky <npostavs@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Wed, 15 Aug 2018 00:48:02 +0000
Resent-Message-ID: <handler.30745.B30745.15342940562669 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 30745
X-GNU-PR-Package: emacs
X-GNU-PR-Keywords: 
To: phillip.lord@HIDDEN (Phillip Lord)
Cc: 30745 <at> debbugs.gnu.org, 24402 <at> debbugs.gnu.org
Received: via spool by 30745-submit <at> debbugs.gnu.org id=B30745.15342940562669
          (code B ref 30745); Wed, 15 Aug 2018 00:48:02 +0000
Received: (at 30745) by debbugs.gnu.org; 15 Aug 2018 00:47:36 +0000
Received: from localhost ([127.0.0.1]:51200 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1fpjyJ-0000gt-63
	for submit <at> debbugs.gnu.org; Tue, 14 Aug 2018 20:47:36 -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 <npostavs@HIDDEN>)
 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 <npostavs@HIDDEN>
References: <874llr4lk1.fsf@HIDDEN> <87r2ov1l46.fsf@HIDDEN>
 <87sh9blzfy.fsf@HIDDEN>
Date: Tue, 14 Aug 2018 20:47:21 -0400
In-Reply-To: <87sh9blzfy.fsf@HIDDEN> (Phillip Lord's message of "Thu,
 08 Mar 2018 08:54:41 +0000")
Message-ID: <87lg98xxpi.fsf@HIDDEN>
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 <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain

block 30745 by 24618
tags 30745 + patch
quit

phillip.lord@HIDDEN (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 <npostavs@HIDDEN>
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 <npostavs@HIDDEN>
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 <npostavs@HIDDEN>
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


--=-=-=--

Message received at control <at> debbugs.gnu.org:

Received: (at control) by debbugs.gnu.org; 15 Aug 2018 00:47:33 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Tue Aug 14 20:47:33 2018
Received: from localhost ([127.0.0.1]:51196 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1fpjyG-0000gi-Dv
	for submit <at> 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 <npostavs@HIDDEN>)
 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 <npostavs@HIDDEN>
To: phillip.lord@HIDDEN (Phillip Lord)
Subject: Re: bug#30745: 26.0.91; ert should macros nest strangely
References: <874llr4lk1.fsf@HIDDEN> <87r2ov1l46.fsf@HIDDEN>
 <87sh9blzfy.fsf@HIDDEN>
Date: Tue, 14 Aug 2018 20:47:21 -0400
In-Reply-To: <87sh9blzfy.fsf@HIDDEN> (Phillip Lord's message of "Thu,
 08 Mar 2018 08:54:41 +0000")
Message-ID: <87lg98xxpi.fsf@HIDDEN>
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 <at> debbugs.gnu.org, 24402 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain

block 30745 by 24618
tags 30745 + patch
quit

phillip.lord@HIDDEN (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 <npostavs@HIDDEN>
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 <npostavs@HIDDEN>
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 <npostavs@HIDDEN>
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


--=-=-=--

Message received at control <at> debbugs.gnu.org:

Received: (at control) by debbugs.gnu.org; 15 Aug 2018 00:47:33 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Tue Aug 14 20:47:33 2018
Received: from localhost ([127.0.0.1]:51196 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1fpjyG-0000gi-Dv
	for submit <at> 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 <npostavs@HIDDEN>)
 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 <npostavs@HIDDEN>
To: phillip.lord@HIDDEN (Phillip Lord)
Subject: Re: bug#30745: 26.0.91; ert should macros nest strangely
References: <874llr4lk1.fsf@HIDDEN> <87r2ov1l46.fsf@HIDDEN>
 <87sh9blzfy.fsf@HIDDEN>
Date: Tue, 14 Aug 2018 20:47:21 -0400
In-Reply-To: <87sh9blzfy.fsf@HIDDEN> (Phillip Lord's message of "Thu,
 08 Mar 2018 08:54:41 +0000")
Message-ID: <87lg98xxpi.fsf@HIDDEN>
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 <at> debbugs.gnu.org, 24402 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain

block 30745 by 24618
tags 30745 + patch
quit

phillip.lord@HIDDEN (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 <npostavs@HIDDEN>
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 <npostavs@HIDDEN>
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 <npostavs@HIDDEN>
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


--=-=-=--

Message sent to bug-gnu-emacs@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: bug#30745: 26.0.91; ert should macros nest strangely
Resent-From: Lars Ingebrigtsen <larsi@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Mon, 24 Jun 2019 18:55:02 +0000
Resent-Message-ID: <handler.30745.B30745.15614024659870 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 30745
X-GNU-PR-Package: emacs
X-GNU-PR-Keywords: patch
To: Noam Postavsky <npostavs@HIDDEN>
Cc: 30745 <at> debbugs.gnu.org, 24402 <at> debbugs.gnu.org, Phillip Lord <phillip.lord@HIDDEN>
Received: via spool by 30745-submit <at> debbugs.gnu.org id=B30745.15614024659870
          (code B ref 30745); Mon, 24 Jun 2019 18:55:02 +0000
Received: (at 30745) by debbugs.gnu.org; 24 Jun 2019 18:54:25 +0000
Received: from localhost ([127.0.0.1]:57974 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1hfU6i-0002Z0-L2
	for submit <at> debbugs.gnu.org; Mon, 24 Jun 2019 14:54:25 -0400
Received: from quimby.gnus.org ([80.91.231.51]:34976)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <larsi@HIDDEN>)
 id 1hfU6g-0002Ya-7t; Mon, 24 Jun 2019 14:54:22 -0400
Received: from cm-84.212.202.86.getinternet.no ([84.212.202.86] helo=stories)
 by quimby.gnus.org with esmtpsa
 (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89)
 (envelope-from <larsi@HIDDEN>)
 id 1hfU6c-0006ZI-Ef; Mon, 24 Jun 2019 20:54:20 +0200
From: Lars Ingebrigtsen <larsi@HIDDEN>
References: <874llr4lk1.fsf@HIDDEN> <87r2ov1l46.fsf@HIDDEN>
 <87sh9blzfy.fsf@HIDDEN> <87lg98xxpi.fsf@HIDDEN>
Date: Mon, 24 Jun 2019 20:54:18 +0200
In-Reply-To: <87lg98xxpi.fsf@HIDDEN> (Noam Postavsky's message of "Tue, 14
 Aug 2018 20:47:21 -0400")
Message-ID: <m3sgryq0f9.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain
X-Spam-Report: Spam detection software, running on the system "quimby.gnus.org",
 has NOT identified this incoming email as spam.  The original
 message has been attached to this so you can view it or label
 similar future email.  If you have any questions, see
 @@CONTACT_ADDRESS@@ for details.
 Content preview: Noam Postavsky <npostavs@HIDDEN> writes: > 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 handle [...] 
 Content analysis details:   (-2.9 points, 5.0 required)
 pts rule name              description
 ---- ---------------------- --------------------------------------------------
 -1.0 ALL_TRUSTED            Passed through trusted hosts only via SMTP
 -1.9 BAYES_00               BODY: Bayes spam probability is 0 to 1%
 [score: 0.0000]
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

Noam Postavsky <npostavs@HIDDEN> writes:

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

#24618 was fixed a few weeks later, but this patch was never applied?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Message sent to bug-gnu-emacs@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: bug#30745: 26.0.91; ert should macros nest strangely
Resent-From: Noam Postavsky <npostavs@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Mon, 24 Jun 2019 22:54:02 +0000
Resent-Message-ID: <handler.30745.B30745.15614167894193 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 30745
X-GNU-PR-Package: emacs
X-GNU-PR-Keywords: patch
To: Lars Ingebrigtsen <larsi@HIDDEN>
Cc: 30745 <at> debbugs.gnu.org, Phillip Lord <phillip.lord@HIDDEN>, 24402 <at> debbugs.gnu.org
Received: via spool by 30745-submit <at> debbugs.gnu.org id=B30745.15614167894193
          (code B ref 30745); Mon, 24 Jun 2019 22:54:02 +0000
Received: (at 30745) by debbugs.gnu.org; 24 Jun 2019 22:53:09 +0000
Received: from localhost ([127.0.0.1]:58271 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1hfXpl-00015V-Hc
	for submit <at> debbugs.gnu.org; Mon, 24 Jun 2019 18:53:09 -0400
Received: from mail-io1-f49.google.com ([209.85.166.49]:42989)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <npostavs@HIDDEN>)
 id 1hfXpj-00014v-5T; Mon, 24 Jun 2019 18:53:07 -0400
Received: by mail-io1-f49.google.com with SMTP id u19so375293ior.9;
 Mon, 24 Jun 2019 15:53:07 -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=Hn5sYZyp1cCrGZG9FYoaWZG3DV+9rWU7z7Ksn4+R13A=;
 b=l7NwWQX8hMPnD/u/d0bhNWwQNmwmFsVYnjSVmrmVY2Y8B8leImda7mEjpIv8HJ/6V9
 VlxlAashLWmdPZdtCrRSKijk1pDfXIPqY3AhMAILjoNqqibdvDIuzalykpTxM/sJwhDI
 uEQ8zh+smoGixxC/tSp9wcz/5fxnd5jGHFVs49Y3VmoMRR4vzMtoKjpq2romD9JGslBf
 7UoRIpSwPdtTviU3T4pQW6rV5A+5TKaEU13TMcwmywgC/GbO491leJCHusSAbD25dJQY
 esUmxSnDRR2RmR1LVariPLZFiBaGh4X9UyzfNgD6sOYnQfoKyxvAX5DwmooxPg2MF0kR
 BDwA==
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=Hn5sYZyp1cCrGZG9FYoaWZG3DV+9rWU7z7Ksn4+R13A=;
 b=QBkOtuBiMFUk6c3POzBFV+5pWJSWUl9Fme1H78j3xFs8ePG21nyYgYYVL+c1sim0zj
 kdXyiWBNqojWJhAZH5T+vL7sjNTFt0km7Cl4ebW3doj07HS+5uYWDKS48WBA1+dM9jDg
 8sn/NSKbv1q3+oZtizhOcFXvwJ+i0mEZsLwrtEEQZ96cxwrsjZAN1ZwMHDLrVzEp/UQV
 5Buo6Y7+T+UJxxIm1+6m2GNIGsQNEvgysox3rlC8Q3dq0Gi0hq31OFM8ATF+2bdFiKPq
 syrp1AyqTDE5AbXsGfHmAx3nBwsiUaArQOczpbMxMiPiy8fBE+1zRBZ0K0Bcsev/q7fq
 u9nw==
X-Gm-Message-State: APjAAAWAn4lo/DC6FuTE1V3oA2O+MkTp6XHg4QvLY3p3jKNNNUK+m17h
 x0xDYIQetFM/MviZADp+78U=
X-Google-Smtp-Source: APXvYqzN5zGL5VKYjbJY4q3v4I9sDXT/Queyx99A9wAdx87BLgn62vw1KoaUtNtceI6xBwsRQhKjaQ==
X-Received: by 2002:a02:bb08:: with SMTP id y8mr73025445jan.51.1561416781538; 
 Mon, 24 Jun 2019 15:53:01 -0700 (PDT)
Received: from minid (cbl-45-2-119-34.yyz.frontiernetworks.ca. [45.2.119.34])
 by smtp.gmail.com with ESMTPSA id
 a7sm10425535iok.19.2019.06.24.15.53.00
 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256);
 Mon, 24 Jun 2019 15:53:01 -0700 (PDT)
From: Noam Postavsky <npostavs@HIDDEN>
References: <874llr4lk1.fsf@HIDDEN> <87r2ov1l46.fsf@HIDDEN>
 <87sh9blzfy.fsf@HIDDEN> <87lg98xxpi.fsf@HIDDEN>
 <m3sgryq0f9.fsf@HIDDEN>
Date: Mon, 24 Jun 2019 18:53:00 -0400
In-Reply-To: <m3sgryq0f9.fsf@HIDDEN> (Lars Ingebrigtsen's message of "Mon,
 24 Jun 2019 20:54:18 +0200")
Message-ID: <87tvcesiib.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

Lars Ingebrigtsen <larsi@HIDDEN> writes:

> Noam Postavsky <npostavs@HIDDEN> writes:
>
>> 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.
>
> #24618 was fixed a few weeks later, but this patch was never applied?

The main blocker for this is the other thing:

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

Message sent to bug-gnu-emacs@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: bug#30745: 26.0.91; ert should macros nest strangely
Resent-From: Noam Postavsky <npostavs@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Fri, 28 Jun 2019 03:07:04 +0000
Resent-Message-ID: <handler.30745.B30745.156169117023875 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 30745
X-GNU-PR-Package: emacs
X-GNU-PR-Keywords: patch
To: Lars Ingebrigtsen <larsi@HIDDEN>
Cc: 30745 <at> debbugs.gnu.org, 24402 <at> debbugs.gnu.org, Phillip Lord <phillip.lord@HIDDEN>
Received: via spool by 30745-submit <at> debbugs.gnu.org id=B30745.156169117023875
          (code B ref 30745); Fri, 28 Jun 2019 03:07:04 +0000
Received: (at 30745) by debbugs.gnu.org; 28 Jun 2019 03:06:10 +0000
Received: from localhost ([127.0.0.1]:40156 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1hghDF-0006Cw-Nr
	for submit <at> debbugs.gnu.org; Thu, 27 Jun 2019 23:06:09 -0400
Received: from mail-io1-f45.google.com ([209.85.166.45]:32855)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <npostavs@HIDDEN>)
 id 1hghDD-0006Cg-V5; Thu, 27 Jun 2019 23:06:08 -0400
Received: by mail-io1-f45.google.com with SMTP id u13so9466211iop.0;
 Thu, 27 Jun 2019 20:06:07 -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=BByDZOVVVJpGAr8VkafaCf9lm4TD60aoAXdwHTmBKUo=;
 b=aubvOWYhfNmdcvBqPQCu73CB54LxJo9isamal92pgjlgybQopBcv8FZsD7xE65/GMS
 aDQGsY5czysVON8AKbwgl8prm/VOVYtWuF84D1vN6L4oFSJs+xjiipDZkWtHVw4Coeqb
 LWSxForS7sDpB13jj0ZGNglUx7tHheQfM+ulhaENKsEAWkiCn4ERYfRME9frQGbamGg8
 p4U0ldMI1YcSup58ScZt1fqC0S3cFqwcFzA5i046TeLnCjDTSm9gc6/klaocuzr0zF4e
 XkxDNwlD/OfGnvHS44ngeH54UUwUCu5AnKB6XWSwvNBSHHc/Hv6xsWhrM7xmZN+r4Cda
 eCmA==
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=BByDZOVVVJpGAr8VkafaCf9lm4TD60aoAXdwHTmBKUo=;
 b=aXFsLbMnSUAAOBsYbGGVHOzGY5wKvvegBvOp5X5OtWnSM72JBWlMNtDSKFduJsqX3c
 xrgPPFpWlDs6MSkzfuaDq+DqGEua+S/17H4KE7lsXobNDWPcyW/96hGi8C3CLfuHdxP+
 s7s8DgX2ny/e3YDu4I3Zm6png5hkVw6ReOC2DUMNVuN0h25lAVBih5+Vwuq3dlN79mKJ
 9XlKSifBt5St+80g+bBmOQAQsTwBRgvgwjSsFVn9dQSC3y2zpFIJRq3VtGzbCMR3TSq1
 L5yA+GJCT+Qu/slRsDe13pXPiIpV7a9Tq8sPStFI4pC0foCRP6575xfGOzYuAhMAXLQ+
 oUvw==
X-Gm-Message-State: APjAAAV94/I7zq38Ah50kzpg7ttIUjMzyxUzAar45MKsIwaS9CHid7sN
 eUO5WGVhARP8LQqd+kU/8+6bskt1
X-Google-Smtp-Source: APXvYqzjawHeZE5goK9osq/zUbcIf+rqfFgMtY2C627nll2PjvZu/KNFgedDLw+VjsXFcB6R1MLiXQ==
X-Received: by 2002:a5e:8618:: with SMTP id z24mr8768363ioj.174.1561691162217; 
 Thu, 27 Jun 2019 20:06:02 -0700 (PDT)
Received: from minid (cbl-45-2-119-34.yyz.frontiernetworks.ca. [45.2.119.34])
 by smtp.gmail.com with ESMTPSA id
 m25sm3071282ion.35.2019.06.27.20.06.01
 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256);
 Thu, 27 Jun 2019 20:06:01 -0700 (PDT)
From: Noam Postavsky <npostavs@HIDDEN>
References: <874llr4lk1.fsf@HIDDEN> <87r2ov1l46.fsf@HIDDEN>
 <87sh9blzfy.fsf@HIDDEN> <87lg98xxpi.fsf@HIDDEN>
 <m3sgryq0f9.fsf@HIDDEN> <87tvcesiib.fsf@HIDDEN>
Date: Thu, 27 Jun 2019 23:06:00 -0400
In-Reply-To: <87tvcesiib.fsf@HIDDEN> (Noam Postavsky's message of "Mon, 24
 Jun 2019 18:53:00 -0400")
Message-ID: <87y31m5rzb.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2.90 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

Noam Postavsky <npostavs@HIDDEN> writes:

> The main blocker for this is the other thing:
>
>>> 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.

Also it seems to be breaking some electric tests

   FAILED  electric-layout-plainer-c-mode-use-c-style
   FAILED  electric-modes-int-main-allman-style

I don't really have any clue why though.

Message sent to bug-gnu-emacs@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: bug#30745: 26.0.91; ert should macros nest strangely
Resent-From: Philipp Stephani <p.stephani2@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Sun, 29 Nov 2020 10:37:02 +0000
Resent-Message-ID: <handler.30745.B30745.160664616312666 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 30745
X-GNU-PR-Package: emacs
X-GNU-PR-Keywords: patch
To: Noam Postavsky <npostavs@HIDDEN>
Cc: Lars Ingebrigtsen <larsi@HIDDEN>, Phillip Lord <phillip.lord@HIDDEN>, 30745 <at> debbugs.gnu.org, 24402 <at> debbugs.gnu.org
Received: via spool by 30745-submit <at> debbugs.gnu.org id=B30745.160664616312666
          (code B ref 30745); Sun, 29 Nov 2020 10:37:02 +0000
Received: (at 30745) by debbugs.gnu.org; 29 Nov 2020 10:36:03 +0000
Received: from localhost ([127.0.0.1]:49797 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1kjK3m-0003ID-L1
	for submit <at> debbugs.gnu.org; Sun, 29 Nov 2020 05:36:02 -0500
Received: from mail-ot1-f41.google.com ([209.85.210.41]:33832)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <p.stephani2@HIDDEN>)
 id 1kjK3j-0003He-Q2; Sun, 29 Nov 2020 05:36:00 -0500
Received: by mail-ot1-f41.google.com with SMTP id h19so8689331otr.1;
 Sun, 29 Nov 2020 02:35:59 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025;
 h=mime-version:references:in-reply-to:from:date:message-id:subject:to
 :cc; bh=xbx0xmAY36ozktBMFyIOtqj+MVifM0OdN1igaGEX4yo=;
 b=V+ZbHswFdAJTbzkAZ1itKRnAFUnsHaXLdloOX1RL2ABkA933qmq2CrUOA+icAD/fAN
 o9x3FF1k4ho0k2W0Q7avQMuZE+7nHS70Ktneqgo5X372eA62+0eQsgSNJFvvl7INgIKk
 F67XMAtTJENyKATIst7fAGk49s82lfnSwkDOpTB+VspzjNZZZORO0KzQ9Q1qno/Nh812
 sPi6daLDvzOsI8Q79Ps4rfyM8mHN+Cd+DhqkjhXtOLnknpZoumc3OuzY3izKLguhftvs
 JB4alPXzF5BUyjXFH4zClsFTX2hFFmYoW9HT9sc2wXQyslyRE8dMKlkxHdhmjl+pWiCY
 I+Bg==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20161025;
 h=x-gm-message-state:mime-version:references:in-reply-to:from:date
 :message-id:subject:to:cc;
 bh=xbx0xmAY36ozktBMFyIOtqj+MVifM0OdN1igaGEX4yo=;
 b=plRPrnL40OH3TeVn9tiNTCg3iFD4ZKYOoUeQOmzqC6Ez0nBn54nk/CracJVUBpoadE
 UWCo4nUs5nWsn4+lTwgb/KBrcve9nYtuHJnfdsTNjxDmKwQW2TdX7FQn+PfkzVOfYue8
 FkOJrlSuoJnT2sFB6yo+FpPcF0W50x00EDKJUr0ezY9Eq+SgxyRMo3gyb/8rUDAuGxnC
 R21gpbqvA0aawKgeXtvFWceroJc8EAuzQYnEStNpnzF07LY4nThD0BJfFmJez5RbOYUy
 5/j5DcjD6vKKhPqoVVGJ5cMYkaXU3jrROt9w2t6YpPMS+m2iBlvVahYuxT2k+o3gTsUX
 MEcA==
X-Gm-Message-State: AOAM533DUc4vhJILs75ZizrjMtbK17AMqa0TUUAnQC+YOI3KzwuTj6BM
 QF68XrbDjjGa+jvHlgK//uflRcLv/50vEyC0Urk=
X-Google-Smtp-Source: ABdhPJxOK3LEAWH0N6r0Ta9bBmHUHSC3ifLgfTXabcA1rdNOCYpXO79pzT2raU7wvgRm8If4f2rt6ibVGsEilCkvA5E=
X-Received: by 2002:a9d:72c4:: with SMTP id d4mr12631138otk.149.1606646154010; 
 Sun, 29 Nov 2020 02:35:54 -0800 (PST)
MIME-Version: 1.0
References: <874llr4lk1.fsf@HIDDEN> <87r2ov1l46.fsf@HIDDEN>
 <87sh9blzfy.fsf@HIDDEN> <87lg98xxpi.fsf@HIDDEN>
 <m3sgryq0f9.fsf@HIDDEN> <87tvcesiib.fsf@HIDDEN>
In-Reply-To: <87tvcesiib.fsf@HIDDEN>
From: Philipp Stephani <p.stephani2@HIDDEN>
Date: Sun, 29 Nov 2020 11:35:43 +0100
Message-ID: <CAArVCkT5UGeX8DkH+QXTk0dh2yh-SWwfx5it0351gkBT3MPLvQ@HIDDEN>
Content-Type: text/plain; charset="UTF-8"
X-Spam-Score: 0.3 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -0.7 (/)

Am Di., 25. Juni 2019 um 00:54 Uhr schrieb Noam Postavsky <npostavs@HIDDEN>:
>
> Lars Ingebrigtsen <larsi@HIDDEN> writes:
>
> > Noam Postavsky <npostavs@HIDDEN> writes:
> >
> >> 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.
> >
> > #24618 was fixed a few weeks later, but this patch was never applied?
>
> The main blocker for this is the other thing:
>
> >> 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.
>

How many tests (besides the jsonrpc one) do we expect to be broken due
to this? It seems that tests relying on such a bug are inherently
brittle, so maybe we can bite the bullet and apply the patch
nevertheless? Or introduce another hack in process.c that treats ERT
tests specially, as if debug-on-error were bound?

Message sent to bug-gnu-emacs@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: bug#30745: 26.0.91; ert should macros nest strangely
Resent-From: Lars Ingebrigtsen <larsi@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Thu, 22 Jul 2021 13:14:02 +0000
Resent-Message-ID: <handler.30745.B30745.16269596211159 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 30745
X-GNU-PR-Package: emacs
X-GNU-PR-Keywords: patch
To: Philipp Stephani <p.stephani2@HIDDEN>
Cc: 30745 <at> debbugs.gnu.org, 24402 <at> debbugs.gnu.org, Noam Postavsky <npostavs@HIDDEN>, Phillip Lord <phillip.lord@HIDDEN>
Received: via spool by 30745-submit <at> debbugs.gnu.org id=B30745.16269596211159
          (code B ref 30745); Thu, 22 Jul 2021 13:14:02 +0000
Received: (at 30745) by debbugs.gnu.org; 22 Jul 2021 13:13:41 +0000
Received: from localhost ([127.0.0.1]:39731 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1m6YWD-0000IX-Gx
	for submit <at> debbugs.gnu.org; Thu, 22 Jul 2021 09:13:41 -0400
Received: from quimby.gnus.org ([95.216.78.240]:54912)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <larsi@HIDDEN>)
 id 1m6YWA-0000IF-RS; Thu, 22 Jul 2021 09:13:40 -0400
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnus.org;
 s=20200322; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date:
 References:Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:
 Content-ID:Content-Description:Resent-Date:Resent-From:Resent-Sender:
 Resent-To:Resent-Cc:Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:
 List-Subscribe:List-Post:List-Owner:List-Archive;
 bh=kdY+oKjvuh6Pf0M3pAaM4Yjbk8cRMa+uOfOlytk/5Cw=; b=liy4mJwfVgkO2w/taDjphnAcWW
 mxKuRBcyFgtJBDnWIxoWlBwmzhWbY0nFgIRVQUbDknaDwCfKX4Agpy2QwEhOPAtrHKV4Q8EP7mX4c
 uwEzvwzFgATBICWMbp1VzIPTrSpvevZyrslBt3KADKVCEgKtmx3cEpEum0foDDOvk2eI=;
Received: from cm-84.212.220.105.getinternet.no ([84.212.220.105] helo=elva)
 by quimby.gnus.org with esmtpsa (TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.92) (envelope-from <larsi@HIDDEN>)
 id 1m6YW2-0002hO-4E; Thu, 22 Jul 2021 15:13:32 +0200
From: Lars Ingebrigtsen <larsi@HIDDEN>
References: <874llr4lk1.fsf@HIDDEN> <87r2ov1l46.fsf@HIDDEN>
 <87sh9blzfy.fsf@HIDDEN> <87lg98xxpi.fsf@HIDDEN>
 <m3sgryq0f9.fsf@HIDDEN> <87tvcesiib.fsf@HIDDEN>
 <CAArVCkT5UGeX8DkH+QXTk0dh2yh-SWwfx5it0351gkBT3MPLvQ@HIDDEN>
X-Now-Playing: John T. Gast's _Inna Babalon_: "Celtfunk"
Date: Thu, 22 Jul 2021 15:13:29 +0200
In-Reply-To: <CAArVCkT5UGeX8DkH+QXTk0dh2yh-SWwfx5it0351gkBT3MPLvQ@HIDDEN>
 (Philipp Stephani's message of "Sun, 29 Nov 2020 11:35:43 +0100")
Message-ID: <874kcmjxty.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux)
MIME-Version: 1.0
Content-Type: text/plain
X-Spam-Report: Spam detection software, running on the system "quimby.gnus.org",
 has NOT identified this incoming email as spam.  The original
 message has been attached to this so you can view it or label
 similar future email.  If you have any questions, see
 @@CONTACT_ADDRESS@@ for details.
 Content preview: Philipp Stephani <p.stephani2@HIDDEN> writes: > How many
 tests (besides the jsonrpc one) do we expect to be broken due > to this?
 It seems that tests relying on such a bug are inherently > brittle, so maybe
 we can bite the bullet and apply the pa [...] 
 Content analysis details:   (-2.9 points, 5.0 required)
 pts rule name              description
 ---- ---------------------- --------------------------------------------------
 -1.0 ALL_TRUSTED            Passed through trusted hosts only via SMTP
 -1.9 BAYES_00               BODY: Bayes spam probability is 0 to 1%
 [score: 0.0000]
X-Spam-Score: -2.3 (--)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

Philipp Stephani <p.stephani2@HIDDEN> writes:

> How many tests (besides the jsonrpc one) do we expect to be broken due
> to this? It seems that tests relying on such a bug are inherently
> brittle, so maybe we can bite the bullet and apply the patch
> nevertheless? Or introduce another hack in process.c that treats ERT
> tests specially, as if debug-on-error were bound?

I wanted to try Noam's patch set, but it's two years old, so it doesn't
apply any more.  Noam, do you have an updated patch set, by any chance?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Last modified: Thu, 22 Jul 2021 13:15:02 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.