bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

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

Package: Emacs
Version: 30.0.50


`condition-case` has served us well for the usual error handling needs
of common code, but it does not let us capture information about
the dynamic context where the error takes place, such as
capturing the value of dynamically scoped vars or the backtrace.

For that reason, `signal_or_quit` has slowly grown as new needs have
come up to run various kinds of debugger-like operations in
special cases.

The attached patch adds the new special form `handler-bind` which
provides a functionality similar to `condition-case` except that
the handler is run *before* unwinding the stack.

The patch includes a change to `ert.el` to make use of it to capture the
backtrace of errors instead of messing with `debugger` and
`debug-on-error`, which is fiddly and comes with various problems (such
as the fact that it impacts `condition-case-unless-debug`).

It's not completely finished but I'm bumping into a question.
`ert-tests.el` includes the following test:

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

Until now, this test passes just like that, i.e. without entering
the debugger.  With the new code, this test does enter the debugger.

Can anyone give me a hand figuring out why/how the debugger is not entered
with the current code?  AFAICT when running the inner `ert-run-test`,
we get to `ert--run-test-internal` which sets `debugger` to a function
that calls `ert--run-test-debugger` and `debug-on-error` to t, yet when
it calls `(error "Error message")` this debugger-function is not called
(or at least `ert--run-test-debugger` is not called), which I can't explain.


        Stefan

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: handler-bind.patch --]
[-- Type: text/x-diff, Size: 17896 bytes --]

diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 84b50777684..f73abee1587 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -278,13 +278,12 @@ ert--signal-should-execution
   (when ert--should-execution-observer
     (funcall ert--should-execution-observer form-description)))
 
-;; See Bug#24402 for why this exists
+;; See Bug#24402 for why this existed.  Now we keep it simply
+;; for the sake of old `.elc' files compiled with an old `ert.el'.
 (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 (cons error-symbol data))))
+  (declare (obsolete nil "30.1"))
+  (let ((signal-hook-function nil))
+    (signal error-symbol data)))
 
 (defun ert--special-operator-p (thing)
   "Return non-nil if THING is a symbol naming a special operator."
@@ -324,8 +323,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)))))))
@@ -728,78 +726,65 @@ ert--test-execution-info
   ;; 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.
+(defun ert--run-test-debugger (info condition)
+  "Error handler used during the test run.
 
 This function records failures and errors and either terminates
 the test silently or calls the interactive debugger, as
 appropriate.
 
-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-at-point-debugging-errors',
-              ;; (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)))))))
+INFO is the `ert--test-execution-info' corresponding to this test run.
+ERR is the error object."
+  (let* ((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-at-point-debugging-errors',
+         ;; (i.e., when running interactively) but having the
+         ;; backtrace ready for printing is important for batch
+         ;; use.
+         ;;
+         ;; Grab the frames above ourselves.
+         (backtrace (cdr (backtrace-get-frames 'ert--run-test-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))))
+    ;; 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 debugger 'error condition))
+     (t))
+    (funcall (ert--test-execution-info-exit-continuation info))))
 
 (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)
+  (setf (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
@@ -807,26 +792,14 @@ ert--run-test-internal
     ;; 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 ((lexical-binding t)
-              (debugger (lambda (&rest args)
-                          (ert--run-test-debugger test-execution-info
-                                                  args)))
-              (debug-on-error t)
-              ;; Don't infloop if the error being called is erroring
-              ;; out, and we have `debug-on-error' bound to nil inside
-              ;; the test.
-              (backtrace-on-error-noninteractive nil)
-              (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)
+        (let ((lexical-binding t) ;;FIXME: Why?
               (ert--infos '()))
-          (funcall (ert-test-body (ert--test-execution-info-test
-                                   test-execution-info))))))
+          (handler-bind (((error quit)
+                          (lambda (err)
+                            (ert--run-test-debugger test-execution-info
+                                                    err))))
+            (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))
@@ -1553,7 +1526,9 @@ ert-run-tests-batch-and-exit
   (or noninteractive
       (user-error "This function is only for use in batch mode"))
   (let ((eln-dir (and (featurep 'native-compile)
-                      (make-temp-file "test-nativecomp-cache-" t))))
+                  (make-temp-file "test-nativecomp-cache-" t)))
+        ;; Don't ever wait for user input.
+        (inhibit-interaction t))
     (when eln-dir
       (startup-redirect-eln-cache eln-dir))
     ;; Better crash loudly than attempting to recover from undefined
diff --git a/lisp/subr.el b/lisp/subr.el
index 7b52f4f68f9..7cc5d9ac79b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -7496,6 +7496,36 @@ match-buffers
         (push buf bufs)))
     bufs))
 
+(defmacro handler-bind (handlers &rest body)
+  "Setup error HANDLERS around execution of BODY.
+HANDLERS is a list of (CONDITIONS HANDLER) where
+CONDITIONS should be a list of condition names (symbols) or
+a single condition name and HANDLER is a form whose evaluation
+returns a function.
+When an error is signaled during execution of BODY, if that
+error matches CONDITIONS, then the associated HANDLER
+function is called with the error as argument.
+HANDLERs can either transfer the control via a non-local exit,
+or return normally.  If they return normally the search for an
+error handler continues from where it left off."
+  ;; FIXME: Completion support as in `condition-case'?
+  (declare (indent 1) (debug ((&rest (sexp form)) body)))
+  (let ((args '())
+        (bindings '()))
+    (dolist (cond+handler (reverse handlers))
+      (let ((handler (car (cdr cond+handler)))
+            (conds (car cond+handler))
+            (handlersym (gensym "handler")))
+        (push (list handlersym handler) bindings)
+        (if (not (listp conds))
+            (progn
+              (push handlersym args)
+              (push `',conds args))
+          (dolist (cond conds)
+            (push handlersym args)
+            (push `',cond args)))))
+    `(let ,bindings (handler-bind-1 (lambda () ,@body) ,@args))))
+
 (defmacro with-memoization (place &rest code)
   "Return the value of CODE and stash it in PLACE.
 If PLACE's value is non-nil, then don't bother evaluating CODE
diff --git a/src/eval.c b/src/eval.c
index 12e811ce264..075fbf01238 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1355,6 +1355,42 @@ or (:success BODY...), where the BODY is made of Lisp expressions.
   return internal_lisp_condition_case (var, bodyform, handlers);
 }
 
+DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0,
+       doc: /* Setup error handlers around execution of BODYFUN.
+BODYFUN be a function and it is called with no arguments.
+CONDITION should be a condition name (symbol).
+When an error is signaled during executon of BODYFUN, if that
+error matches CONDITION, then the associated HANDLER is
+called with the error as argument.
+HANDLER should either transfer the control via a non-local exit,
+or return normally.  If it returns normally, it should return a new
+error object or nil, and the search for an error handler continues
+from where it left off, using the new error object returned by
+HANDLER (or the old error object if it returned nil).
+
+(fn BODYFUN [CONDITION HANDLER]...)  */)
+  (ptrdiff_t nargs, Lisp_Object *args)
+{
+  eassert (nargs >= 1);
+  Lisp_Object bodyfun = args[0];
+  Lisp_Object map = Qnil;
+  ptrdiff_t i = 2;
+  while (i < nargs)
+    {
+      Lisp_Object condition = args[i - 1], handler = args[i];
+      map = Fcons (Fcons (condition, handler), map);
+      i += 2;
+    }
+  /* FIXME: Fsignal handles multiple conditions&handlers */
+  struct handler *current_handlerlist = handlerlist;
+  push_handler (Fnreverse (map), HANDLER);
+  eassert (handlerlist->next == current_handlerlist);
+  Lisp_Object ret = call0 (bodyfun);
+  eassert (handlerlist->next == current_handlerlist);
+  handlerlist = handlerlist->next;
+  return ret;
+}
+
 /* Like Fcondition_case, but the args are separate
    rather than passed in a list.  Used by Fbyte_code.  */
 
@@ -1731,6 +1767,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
     = (NILP (error_symbol) ? Fcar (data) : error_symbol);
   Lisp_Object clause = Qnil;
   struct handler *h;
+  int skip;
 
   if (gc_in_progress || waiting_for_input)
     emacs_abort ();
@@ -1772,16 +1809,60 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
 	Vsignaling_function = backtrace_function (pdl);
     }
 
-  for (h = handlerlist; h; h = h->next)
+  for (skip = 0, h = handlerlist; h; skip++, h = h->next)
     {
-      if (h->type == CATCHER_ALL)
+      switch (h->type)
         {
+        case CATCHER_ALL:
           clause = Qt;
           break;
-        }
-      if (h->type != CONDITION_CASE)
-	continue;
-      clause = find_handler_clause (h->tag_or_ch, conditions);
+	case CATCHER:
+	  continue;
+        case CONDITION_CASE:
+          clause = find_handler_clause (h->tag_or_ch, conditions);
+	  break;
+	case HANDLER:
+	  {
+	    Lisp_Object handlers = h->tag_or_ch;
+	    for (; CONSP (handlers); handlers = XCDR (handlers))
+	      {
+	        Lisp_Object handler = XCAR (handlers);
+	        if (CONSP (handler)
+	            && !NILP (Fmemq (XCAR (handler), conditions)))
+	          {
+	            struct handler *current_handlerlist = handlerlist;
+	            Lisp_Object error_data
+	              = (NILP (error_symbol)
+	                 ? data : Fcons (error_symbol, data));
+	            /* FIXME: This inhibits deeper catchers,
+	                 which isn't right!  */
+	            push_handler (make_fixnum (skip), SKIP_CONDITIONS);
+	            eassert (handlerlist->next == current_handlerlist);
+	            Lisp_Object retval = call1 (XCDR (handler), error_data);
+	            /* Pop the SKIP_CONDITIONS.  No need to use unwind_protect
+	               since any non-local exit will set 'handlerlist'.  */
+	            eassert (handlerlist->next == current_handlerlist);
+	            handlerlist = current_handlerlist;
+	            if (CONSP (retval))
+	              {
+	                error_symbol = XCAR (retval);
+	                data = XCDR (retval);
+	                conditions = Fget (error_symbol, Qerror_conditions);
+	              }
+	          }
+	      }
+	    continue;
+	  }
+	case SKIP_CONDITIONS:
+	  {
+	    int toskip = XFIXNUM (h->tag_or_ch);
+	    while (toskip-- >= 0)
+	      h = h->next;
+	    continue;
+	  }
+	default:
+	  abort ();
+	}
       if (!NILP (clause))
 	break;
     }
@@ -1798,7 +1879,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
 	  || (CONSP (clause) && !NILP (Fmemq (Qdebug, clause)))
 	  /* Special handler that means "print a message and run debugger
 	     if requested".  */
-	  || EQ (h->tag_or_ch, Qerror)))
+	  || EQ (clause, Qerror)))
     {
       debugger_called
 	= maybe_call_debugger (conditions, error_symbol, data);
@@ -1813,7 +1894,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
      to not interfere with ERT or other packages that install custom
      debuggers.  */
   if (!debugger_called && !NILP (error_symbol)
-      && (NILP (clause) || EQ (h->tag_or_ch, Qerror))
+      && (NILP (clause) || EQ (clause, Qerror))
       && noninteractive && backtrace_on_error_noninteractive
       && NILP (Vinhibit_debugger)
       && !NILP (Ffboundp (Qdebug_early)))
@@ -2052,13 +2133,10 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions)
   register Lisp_Object h;
 
   /* t is used by handlers for all conditions, set up by C code.  */
-  if (EQ (handlers, Qt))
-    return Qt;
-
   /* error is used similarly, but means print an error message
      and run the debugger if that is enabled.  */
-  if (EQ (handlers, Qerror))
-    return Qt;
+  if (!CONSP (handlers))
+    return handlers;
 
   for (h = handlers; CONSP (h); h = XCDR (h))
     {
@@ -4449,6 +4527,7 @@ syms_of_eval (void)
   defsubr (&Sthrow);
   defsubr (&Sunwind_protect);
   defsubr (&Scondition_case);
+  defsubr (&Shandler_bind_1);
   DEFSYM (QCsuccess, ":success");
   defsubr (&Ssignal);
   defsubr (&Scommandp);
diff --git a/src/lisp.h b/src/lisp.h
index df6cf1df544..33892eb4a68 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3618,7 +3618,8 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
    Members are volatile if their values need to survive _longjmp when
    a 'struct handler' is a local variable.  */
 
-enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL };
+enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL,
+                   HANDLER, SKIP_CONDITIONS };
 
 enum nonlocal_exit
 {

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[Gerd Möllmann]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>     (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)))))
>
> Until now, this test passes just like that, i.e. without entering
> the debugger.  With the new code, this test does enter the debugger.
>
> Can anyone give me a hand figuring out why/how the debugger is not entered
> with the current code?

Could that be from the condition-case that the test puts around the
ert-run-test? Like in

  (condition-case var
      (let ((debug-on-error t))
        (error "error"))
    (error "no debugger"))
    

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

>>     (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)))))
>>
>> Until now, this test passes just like that, i.e. without entering
>> the debugger.  With the new code, this test does enter the debugger.
>>
>> Can anyone give me a hand figuring out why/how the debugger is not entered
>> with the current code?
>
> Could that be from the condition-case that the test puts around the
> ert-run-test? Like in
>
>   (condition-case var
>       (let ((debug-on-error t))
>         (error "error"))
>     (error "no debugger"))

Duh!  Thanks Gerd for making me see the obvious.


        Stefan

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

>>     (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)))))
>>
>> Until now, this test passes just like that, i.e. without entering
>> the debugger.  With the new code, this test does enter the debugger.
>>
>> Can anyone give me a hand figuring out why/how the debugger is not entered
>> with the current code?
>
> Could that be from the condition-case that the test puts around the
> ert-run-test? Like in
>
>   (condition-case var
>       (let ((debug-on-error t))
>         (error "error"))
>     (error "no debugger"))
>     
OK, so now I understand how that test succeeds, but instead I don't
understand why it is expected to succeed or more specifically what it is
intended to test.

AFAICT

            (let ((ert-debug-on-error t))
              (ert-run-test test))

is supposed to say "run the test and please pop up a debugger if there's
an error".  The ERT code even goes to the trouble to store&use the value of
`ert-debug-on-error` upon entry to the tests rather the value that
happens to be current when the error is signaled.

So to me the code looks like it wants to test that `ert-debug-on-error`
indeed brings up a debugger, tho none of the surrounding code tries to
detect whether the debugger is/was entered, and instead that surrounding
code uses `condition-case` which prevents entering the debugger.

Is it really the purpose of this test to make sure that "even if we ask
for the debugger, `condition-case` prevents the use of a debugger"?


        Stefan

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[Gerd Möllmann]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> AFAICT
>
>             (let ((ert-debug-on-error t))
>               (ert-run-test test))
>
> is supposed to say "run the test and please pop up a debugger if there's
> an error".  The ERT code even goes to the trouble to store&use the value of
> `ert-debug-on-error` upon entry to the tests rather the value that
> happens to be current when the error is signaled.

That's also what I've seen in ert.el, and how I think things are
supposed to work.

> So to me the code looks like it wants to test that `ert-debug-on-error`
> indeed brings up a debugger, tho none of the surrounding code tries to
> detect whether the debugger is/was entered, and instead that surrounding
> code uses `condition-case` which prevents entering the debugger.
>
> Is it really the purpose of this test to make sure that "even if we ask
> for the debugger, `condition-case` prevents the use of a debugger"?

from the fact that the test

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

explicitly tests that the handler for `error' sees the "Error message"
(last 2 lines of the test), I'd also conjecture that tests intends to
check that the debugger does not run in a condition-case.

Also, a bit strange is that this:

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

is almost the saem test? (Uses ert-fail instead of error).

BTW, there are some more tests in the vicinity of the test above that
test if the debugger is/isn't invoked in various circumstances.

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

> BTW, there are some more tests in the vicinity of the test above that
> test if the debugger is/isn't invoked in various circumstances.

Thanks for helping me through this code.

My conclusion is that the three tests that are broken by the use of
`handler-bind` are "bad" tests in the sense that they tested for
a behavior which corresponds to a failure of ERT (they verified that
ERT's error-tracing infrastructure is rendered inoperable by
a surrounding `condition-case`, which amounts to saying that ERT was not
working correctly when called within a `condition-case`).


        Stefan

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[Gerd Möllmann]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> My conclusion is that the three tests that are broken by the use of
> `handler-bind` are "bad" tests in the sense that they tested for
> a behavior which corresponds to a failure of ERT (they verified that
> ERT's error-tracing infrastructure is rendered inoperable by
> a surrounding `condition-case`, which amounts to saying that ERT was not
> working correctly when called within a `condition-case`).

That makes sense, yes.

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[Eli Zaretskii]

> Cc: 67862-done@debbugs.gnu.org, Christian Ohler <ohler@gnu.org>
> From: Gerd Möllmann <gerd.moellmann@gmail.com>
> Date: Mon, 01 Jan 2024 06:56:44 +0100
> 
> Stefan Monnier <monnier@iro.umontreal.ca> writes:
> 
> > My conclusion is that the three tests that are broken by the use of
> > `handler-bind` are "bad" tests in the sense that they tested for
> > a behavior which corresponds to a failure of ERT (they verified that
> > ERT's error-tracing infrastructure is rendered inoperable by
> > a surrounding `condition-case`, which amounts to saying that ERT was not
> > working correctly when called within a `condition-case`).
> 
> That makes sense, yes.

I wonder why should we leave these tests in the files, instead of
removing them?  What purpose does that serve?

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

> I wonder why should we leave these tests in the files, instead of
> removing them?  What purpose does that serve?

Agreed, I'll remove them.


        Stefan

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[J.P.]

Hi Stefan,

Apologies if this is old news, but I think I've noticed a difference in
ERT's behavior that may align with this feature's introduction.

With a snippet like this somewhere in lisp/emacs-lisp/ert-tests.el:

  (ert-deftest my-baseline ()
    (error "Done wrong"))

  (ert-deftest my-filter ()
    (let ((proc
           (start-process "my-filter" (current-buffer) "sh" "-c"
                          "for i in $(seq 99); do echo $i; sleep 0.01; done")))
      (set-process-filter proc
                          (lambda (_ string)
                            (when (string-search "42" string)
                              (error "Encountered bad value"))))
      (with-timeout (5 (ert-fail "Timed out"))
        (while (process-live-p proc)
          (accept-process-output nil 0.01)))))

  (ert-deftest my-timer ()
    (run-at-time 0.2 nil (lambda () (error "Encountered a problem")))
    (with-timeout (5 (ert-fail "Timed out"))
      (while (accept-process-output nil 5))))

Run

  $ make -C test SELECTOR=my-baseline lisp/emacs-lisp/ert-tests.log
  $ make -C test SELECTOR=my-filter lisp/emacs-lisp/ert-tests.log
  $ make -C test SELECTOR=my-timer lisp/emacs-lisp/ert-tests.log

(For me, doing everything in one go, e.g., with SELECTOR='"my-.*"',
doesn't complete on master, so the output below is from separate runs.)


Old behavior
============
Prior to fe0f15dbc96 "ert.el: Use `handler-bind` to record backtraces"

SELECTOR=my-baseline

  -*- mode: compilation; default-directory: "~/emacs/handler-bind/test/" -*-
  Compilation started at Thu Feb  1 14:00:41

  make lisp/emacs-lisp/ert-tests.log
    ELC+ELN  lisp/emacs-lisp/ert-tests.elc
    GEN      lisp/emacs-lisp/ert-tests.log
  Running 1 tests (2024-02-01 14:00:45-0800, selector `my-baseline')
  Test my-baseline backtrace:
    error("Done wrong")
    (closure (ert--test-body-was-run t) nil (error "Done wrong") nil)()
    ert--run-test-internal(#s(ert--test-execution-info :test #s(ert-test
    ert-run-test(#s(ert-test :name my-baseline :documentation nil :
    ert-run-or-rerun-test(#s(ert--stats :selector my-baseline :test
    ert-run-tests(my-baseline #f(compiled-function (event-type &res
    ert-run-tests-batch(my-baseline)
    ert-run-tests-batch-and-exit(my-baseline)
    eval((ert-run-tests-batch-and-exit 'my-baseline) t)
    command-line-1(("-L" ":." "-l" "ert" "-l" "lisp/emacs-lisp/ert-tests
    command-line()
    normal-top-level()
  Test my-baseline condition:
      (error "Done wrong")
     FAILED  1/1  my-baseline (0.000469 sec) at lisp/emacs-lisp/ert-tests.el:904

  Ran 1 tests, 0 results as expected, 1 unexpected (2024-02-01 14:00:46-0800, 0.428006 sec)

  1 unexpected results:
     FAILED  my-baseline  "Done wrong"

  make: *** [Makefile:181: lisp/emacs-lisp/ert-tests.log] Error 1

  Compilation exited abnormally with code 2 at Thu Feb  1 14:00:46, duration 4.32 s


SELECTOR=my-filter

  -*- mode: compilation; default-directory: "~/emacs/handler-bind/test/" -*-
  Compilation started at Thu Feb  1 14:03:54

  make lisp/emacs-lisp/ert-tests.log
    ELC+ELN  lisp/emacs-lisp/ert-tests.elc
    GEN      lisp/emacs-lisp/ert-tests.log
  Running 1 tests (2024-02-01 14:03:58-0800, selector `my-filter')
  Test my-filter backtrace:
    error("Encountered bad value")
    (progn (error "Encountered bad value"))
    (if (string-search "42" string) (progn (error "Encountered bad value
    (closure (t) (_ string) (if (string-search "42" string) (progn (erro
    accept-process-output(nil 0.01)
    (while (process-live-p proc) (accept-process-output nil 0.01))
    (progn (while (process-live-p proc) (accept-process-output nil 0.01)
    (unwind-protect (progn (while (process-live-p proc) (accept-process-
    (let* ((-with-timeout-timer- (run-with-timer 5 nil #'(lambda nil (th
    (catch 'timeout (let* ((-with-timeout-timer- (run-with-timer 5 nil #
    (let ((-with-timeout-value- (catch 'timeout (let* ((-with-timeout-ti
    (let ((proc (start-process "my-filter" (current-buffer) "sh" "-c" "f
    (closure (ert--test-body-was-run t) nil (let ((proc (start-process "
    ert--run-test-internal(#s(ert--test-execution-info :test #s(ert-test
    ert-run-test(#s(ert-test :name my-filter :documentation nil :body (c
    ert-run-or-rerun-test(#s(ert--stats :selector my-filter :tests [#s(e
    ert-run-tests(my-filter #f(compiled-function (event-type &rest event
    ert-run-tests-batch(my-filter)
    ert-run-tests-batch-and-exit(my-filter)
    eval((ert-run-tests-batch-and-exit 'my-filter) t)
    command-line-1(("-L" ":." "-l" "ert" "-l" "lisp/emacs-lisp/ert-tests
    command-line()
    normal-top-level()
  Test my-filter condition:
      (error "Encountered bad value")
     FAILED  1/1  my-filter (0.476963 sec) at lisp/emacs-lisp/ert-tests.el:907

  Ran 1 tests, 0 results as expected, 1 unexpected (2024-02-01 14:03:59-0800, 1.204823 sec)

  1 unexpected results:
     FAILED  my-filter  "Encountered bad value"

  make: *** [Makefile:181: lisp/emacs-lisp/ert-tests.log] Error 1

  Compilation exited abnormally with code 2 at Thu Feb  1 14:03:59, duration 5.12 s


SELECTOR=my-timer

  -*- mode: compilation; default-directory: "~/emacs/handler-bind/test/" -*-
  Compilation started at Thu Feb  1 14:04:46

  make lisp/emacs-lisp/ert-tests.log
    GEN      lisp/emacs-lisp/ert-tests.log
  Running 1 tests (2024-02-01 14:04:47-0800, selector `my-timer')
  Test my-timer backtrace:
    error("Encountered a problem")
    (closure (ert--test-body-was-run t) nil (error "Encountered a proble
    apply((closure (ert--test-body-was-run t) nil (error "Encountered a 
    timer-event-handler([t 26044 5504 133541 nil (closure (ert--test-bod
    accept-process-output(nil 5)
    (while (accept-process-output nil 5))
    (progn (while (accept-process-output nil 5)))
    (unwind-protect (progn (while (accept-process-output nil 5))) (cance
    (let* ((-with-timeout-timer- (run-with-timer 5 nil #'(lambda nil (th
    (catch 'timeout (let* ((-with-timeout-timer- (run-with-timer 5 nil #
    (let ((-with-timeout-value- (catch 'timeout (let* ((-with-timeout-ti
    (closure (ert--test-body-was-run t) nil (run-at-time 0.2 nil #'(lamb
    ert--run-test-internal(#s(ert--test-execution-info :test #s(ert-test
    ert-run-test(#s(ert-test :name my-timer :documentation nil :body (cl
    ert-run-or-rerun-test(#s(ert--stats :selector my-timer :tests [#s(er
    ert-run-tests(my-timer #f(compiled-function (event-type &rest event-
    ert-run-tests-batch(my-timer)
    ert-run-tests-batch-and-exit(my-timer)
    eval((ert-run-tests-batch-and-exit 'my-timer) t)
    command-line-1(("-L" ":." "-l" "ert" "-l" "lisp/emacs-lisp/ert-tests
    command-line()
    normal-top-level()
  Test my-timer condition:
      (error "Encountered a problem")
     FAILED  1/1  my-timer (0.201019 sec) at lisp/emacs-lisp/ert-tests.el:919

  Ran 1 tests, 0 results as expected, 1 unexpected (2024-02-01 14:04:48-0800, 0.701159 sec)

  1 unexpected results:
     FAILED  my-timer  "Encountered a problem"

  make: *** [Makefile:181: lisp/emacs-lisp/ert-tests.log] Error 1

  Compilation exited abnormally with code 2 at Thu Feb  1 14:04:48, duration 1.86 s


New behavior
============
HEAD happens to at 71b5d5a9799 "; Fix typos"

SELECTOR=my-baseline

  -*- mode: compilation; default-directory: "~/emacs/master/test/" -*-
  Compilation started at Thu Feb  1 13:54:48

  make lisp/emacs-lisp/ert-tests.log
    ELC+ELN  lisp/emacs-lisp/ert-tests.elc
    GEN      lisp/emacs-lisp/ert-tests.log
  Running 1 tests (2024-02-01 13:54:52-0800, selector `my-baseline')
  Test my-baseline backtrace:
    error("Done wrong")
    (closure (ert--test-body-was-run t) nil (error "Done wrong") nil)()
    #f(compiled-function () #<bytecode 0x6b4b3301354d5f2>)()
    handler-bind-1(#f(compiled-function () #<bytecode 0x6b4b3301354d5f2>
    ert--run-test-internal(#s(ert--test-execution-info :test #s(ert-test
    ert-run-test(#s(ert-test :name my-baseline :documentation nil :
    ert-run-or-rerun-test(#s(ert--stats :selector my-baseline :test
    ert-run-tests(my-baseline #f(compiled-function (event-type &res
    ert-run-tests-batch(my-baseline)
    ert-run-tests-batch-and-exit(my-baseline)
    eval((ert-run-tests-batch-and-exit 'my-baseline) t)
    command-line-1(("-L" ":." "-l" "ert" "-l" "lisp/emacs-lisp/ert-tests
    command-line()
    normal-top-level()
  Test my-baseline condition:
      (error "Done wrong")
     FAILED  1/1  my-baseline (0.000371 sec) at lisp/emacs-lisp/ert-tests.el:879

  Ran 1 tests, 0 results as expected, 1 unexpected (2024-02-01 13:54:52-0800, 0.495511 sec)

  1 unexpected results:
     FAILED  my-baseline  "Done wrong"

  make: *** [Makefile:181: lisp/emacs-lisp/ert-tests.log] Error 1

  Compilation exited abnormally with code 2 at Thu Feb  1 13:54:52, duration 4.49 s


SELECTOR=my-filter

  -*- mode: compilation; default-directory: "~/emacs/master/test/" -*-
  Compilation started at Thu Feb  1 13:55:59

  make lisp/emacs-lisp/ert-tests.log
    GEN      lisp/emacs-lisp/ert-tests.log
  Running 1 tests (2024-02-01 13:56:00-0800, selector `my-filter')
  error in process filter: Encountered bad value
  make: *** [Makefile:181: lisp/emacs-lisp/ert-tests.log] Error 255

  Compilation exited abnormally with code 2 at Thu Feb  1 13:56:01, duration 1.69 s


SELECTOR=my-timer

  Running 1 tests (2024-02-01 13:56:46-0800, selector `my-timer')
  Error running timer: (error "Encountered a problem")
     passed  1/1  my-timer (5.005249 sec)

  Ran 1 tests, 1 results as expected, 0 unexpected (2024-02-01 13:56:51-0800, 5.005712 sec)


I suppose folks who prefer a backtrace can always wrap their filters and
timers in their own `handler-bind' forms, but the premature exit thing
would seem to affect anything that greps the output for well known
indicators, like "FAILED". These might include tests that spawn other
tests and external scripts.

Anyway, thanks a lot for adding this feature. It should prove quite
useful to ERC.

J.P.

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Hi J.P.,

>   (ert-deftest my-baseline ()
>     (error "Done wrong"))
>
>   (ert-deftest my-filter ()
>     (let ((proc
>            (start-process "my-filter" (current-buffer) "sh" "-c"
>                           "for i in $(seq 99); do echo $i; sleep 0.01; done")))
>       (set-process-filter proc
>                           (lambda (_ string)
>                             (when (string-search "42" string)
>                               (error "Encountered bad value"))))
>       (with-timeout (5 (ert-fail "Timed out"))
>         (while (process-live-p proc)
>           (accept-process-output nil 0.01)))))
>
>   (ert-deftest my-timer ()
>     (run-at-time 0.2 nil (lambda () (error "Encountered a problem")))
>     (with-timeout (5 (ert-fail "Timed out"))
>       (while (accept-process-output nil 5))))

Thanks.  Indeed, `handler-bind` behaves differently than
`debug-on-error` here.  The reason is:

- For `my-filter`, process.c:6329 it's the `!NILP (Vdebug_on_error)` test in:

    internal_condition_case_1 (read_process_output_call,
			       list3 (outstream, make_lisp_proc (p), text),
			       !NILP (Vdebug_on_error) ? Qnil : Qerror,
			       read_process_output_error_handler);

- For `my-timer`, it's the `condition-case-unless-debug` in timer.el:319:

        (condition-case-unless-debug err
            ;; Timer functions should not change the current buffer.
            ;; If they do, all kinds of nasty surprises can happen,
            ;; and it can be hellish to track down their source.
            (save-current-buffer
              (apply (timer--function timer) (timer--args timer)))
          (error (message "Error running timer%s: %S"
                          (if (symbolp (timer--function timer))
                              (format-message " `%s'" (timer--function timer))
                            "")
                          err)))

The reason to catch errors in those two cases is that these codes are
normally run asynchronously, so it makes sense to catch errors rather
than propagate them up to some unrelated ambient code being executed.

For `my-filter` I can see a good argument that errors should be
propagated when you pass `proc` explicitly to `accept-process-output`
and the filter/sentinel that signals the error is indeed this very
process: in that case, there is a very clear connection between the
filter/sentinel and the ambient code which would justify propagating
the error.

For `my-timer`, on the other hand, hmm...


        Stefan

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[J.P.]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> - For `my-filter`, process.c:6329 it's the `!NILP (Vdebug_on_error)` test in:
>
>     internal_condition_case_1 (read_process_output_call,
> 			       list3 (outstream, make_lisp_proc (p), text),
> 			       !NILP (Vdebug_on_error) ? Qnil : Qerror,
> 			       read_process_output_error_handler);
>
> - For `my-timer`, it's the `condition-case-unless-debug` in timer.el:319:
>
>         (condition-case-unless-debug err
>             ;; Timer functions should not change the current buffer.
>             ;; If they do, all kinds of nasty surprises can happen,
>             ;; and it can be hellish to track down their source.
>             (save-current-buffer
>               (apply (timer--function timer) (timer--args timer)))
>           (error (message "Error running timer%s: %S"
>                           (if (symbolp (timer--function timer))
>                               (format-message " `%s'" (timer--function timer))
>                             "")
>                           err)))
>
> The reason to catch errors in those two cases is that these codes are
> normally run asynchronously, so it makes sense to catch errors rather
> than propagate them up to some unrelated ambient code being executed.
>
> For `my-filter` I can see a good argument that errors should be
> propagated when you pass `proc` explicitly to `accept-process-output`
> and the filter/sentinel that signals the error is indeed this very
> process: in that case, there is a very clear connection between the
> filter/sentinel and the ambient code which would justify propagating
> the error.

Appreciate the insight re `debug-on-error'. Indeed, running `my-filter'
with the variable enabled regains the original behavior WRT the
backtrace, the summary, and the exit code. And I suppose those worried
about such details (like ERC's bot, which depends on JUnit reports from
EMBA pipelines) can just enable it themselves.

>
> For `my-timer`, on the other hand, hmm...

For this one, enabling `debug-on-error' at least seems to restore the
original behavior in terms of exiting nonzero, which should free users
from having to grep for "Error running timer" in the output of passing
tests.

  -*- mode: compilation; default-directory: "~/emacs/master/test/" -*-
  Compilation started at Fri Feb  2 14:51:58

  make lisp/emacs-lisp/ert-tests.log
    ELC+ELN  lisp/emacs-lisp/ert-tests.elc
    GEN      lisp/emacs-lisp/ert-tests.log
  Running 1 tests (2024-02-02 14:52:02-0800, selector `my-timer')
  Debugger entered--Lisp error: (error "Encountered a problem")
    error("Encountered a problem")
    (closure (ert--test-body-was-run t) nil (error "Encountered a problem"))()
    apply((closure (ert--test-body-was-run t) nil (error "Encountered a problem")) nil)
    [...]
    ert-run-tests-batch(my-timer)
    ert-run-tests-batch-and-exit(my-timer)
    eval((ert-run-tests-batch-and-exit 'my-timer) t)
    command-line-1(("-L" ":." "-l" "ert" "-l"
     "lisp/emacs-lisp/ert-tests.el" "--eval"
     "(ert-run-tests-batch-and-exit (quote my-timer))"))
    command-line()
    normal-top-level()

  make: *** [Makefile:181: lisp/emacs-lisp/ert-tests.log] Error 255

  Compilation exited abnormally with code 2 at Fri Feb  2 14:52:02, duration 4.30 s

I guess folks who depend on these always running to completion will
still have to adapt a bit, but in light of this workaround, I'd say
these changes are much less disruptive than originally feared, which is
a welcome relief. Thanks.

bug#67862: 30.0.50; Handler-bind and ert-test-error-debug

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

>> For `my-timer`, on the other hand, hmm...
>
> For this one, enabling `debug-on-error' at least seems to restore the
> original behavior in terms of exiting nonzero, which should free users
> from having to grep for "Error running timer" in the output of passing
> tests.

Not getting a backtrace, or ERT not noticing that there was an error is
"normal": which errors are detected and which aren't is subtly different
and it's hard to argue that the old way was better (it has upsides and
downsides).

But inf-looping definitely counts as a bug in my book (since the
`with-timeout` should rule it out) and I don't have an explanation for it.
Any help debugging it would be welcome.


        Stefan