bug#30745: 26.0.91; ert should macros nest strangely

bug#30745: 26.0.91; ert should macros nest strangely

[Phillip Lord]

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.

bug#30745: 26.0.91; ert should macros nest strangely

[Phillip Lord]

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

bug#30745: 26.0.91; ert should macros nest strangely

[Noam Postavsky]

phillip.lord@russet.org.uk (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.

bug#30745: 26.0.91; ert should macros nest strangely

[Phillip Lord]

Noam Postavsky <npostavs@gmail.com> writes:

> phillip.lord@russet.org.uk (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

bug#24402: bug#30745: 26.0.91; ert should macros nest strangely

[Phillip Lord]

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

bug#30745: 26.0.91; ert should macros nest strangely

[Noam Postavsky]

[-- Attachment #1: Type: text/plain, Size: 919 bytes --]

block 30745 by 24618
tags 30745 + patch
quit

phillip.lord@russet.org.uk (Phillip Lord) writes:

> Unfortunately, yes. I didn't try nesting two ert-deftest macros, just
> two should's. As the original bug report suggests it's for testing a
> test library (https://github.com/phillord/assess).
>
> I do have a work around now (which is to unnest the shoulds); and
> fortunately, this work-around is backward compatible which is important
> for me. I still have another test failure in my library,
> though. Probably caused by the same thing but I haven't worked on it
> yet.

I have a patch for ert which removes it's (ab)use of the debugger, it
seems to fix this case (and also Bug#11218).  Note that it relies on my
patch in #24618 for a catch-all condition-case handler clause.

https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24618;filename=0001-Allow-t-as-a-catch-all-condition-case-handler-Bug-24.patch;msg=8;att=1


[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 24076 bytes --]

From e08577437af595325c950dad261a912093af76af Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
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


[-- Attachment #3: Type: text/plain, Size: 281 bytes --]


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:


[-- Attachment #4: patch --]
[-- Type: text/plain, Size: 2021 bytes --]

From d586f0e4e0ec057be047b13aea53a05009ece3cf Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
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


[-- Attachment #5: Type: text/plain, Size: 136 bytes --]


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.


[-- Attachment #6: patch --]
[-- Type: text/plain, Size: 13281 bytes --]

From 3dc99ded842532056f5590d551f42f01024104ca Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
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

bug#30745: 26.0.91; ert should macros nest strangely

[Lars Ingebrigtsen]

Noam Postavsky <npostavs@gmail.com> 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

bug#30745: 26.0.91; ert should macros nest strangely

[Noam Postavsky]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Noam Postavsky <npostavs@gmail.com> 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.

bug#30745: 26.0.91; ert should macros nest strangely

[Noam Postavsky]

Noam Postavsky <npostavs@gmail.com> 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.

bug#30745: 26.0.91; ert should macros nest strangely

[Philipp Stephani]

Am Di., 25. Juni 2019 um 00:54 Uhr schrieb Noam Postavsky <npostavs@gmail.com>:
>
> Lars Ingebrigtsen <larsi@gnus.org> writes:
>
> > Noam Postavsky <npostavs@gmail.com> 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?

bug#30745: 26.0.91; ert should macros nest strangely

[Lars Ingebrigtsen]

Philipp Stephani <p.stephani2@gmail.com> 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