bug#24402: should-error doesn't catch all errors

[Alex <agrambot@gmail.com>]

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

npostavs@users.sourceforge.net writes:

> Yes, ert binds `debugger' in order to get full backtrace information
> when there is an error.  This means it won't see errors caught by
> condition-case.  That's good when it ignores errors caught by test code
> using condition-case, but does give rise to problems.  There is some
> relevant discussion in Bugs #11218 and #24617.
>
> Espcially the suggestion in #24617 of using `signal-hook-function' to
> record error info instead of using `debugger', I think doing this could
> simplify things a lot.  It is definitely going to require messing around
> with ert's internals though...

Thanks for the info. I may have discovered a workaround, but I'm not
sure if there's any negative side-effects. All the tests pass, though.

What do you think of it? It's obviously not ideal, but I think it at
least fixes the issues at hand.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: v3 --]
[-- Type: text/x-diff, Size: 3815 bytes --]

diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index eb2b2e3e11..beb32c48ce 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -266,6 +266,14 @@ 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--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 procedures
+             (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)
@@ -276,13 +284,15 @@ ert--special-operator-p
 (defun ert--expand-should-1 (whole form inner-expander)
   "Helper function for the `should' macro and its variants."
   (let ((form
-         (macroexpand form (append (bound-and-true-p
-                                    byte-compile-macro-environment)
-                                   (cond
-                                    ((boundp 'macroexpand-all-environment)
-                                     macroexpand-all-environment)
-                                    ((boundp 'cl-macro-environment)
-                                     cl-macro-environment))))))
+         (condition-case err
+             (macroexpand-all form (append (bound-and-true-p
+                                            byte-compile-macro-environment)
+                                           (cond
+                                            ((boundp 'macroexpand-all-environment)
+                                             macroexpand-all-environment)
+                                            ((boundp 'cl-macro-environment)
+                                             cl-macro-environment))))
+           (error `(signal ',(car err) ',(cdr err))))))
     (cond
      ((or (atom form) (ert--special-operator-p (car form)))
       (let ((value (cl-gensym "value-")))
@@ -303,8 +313,13 @@ ert--expand-should-1
               (args (cl-gensym "args-"))
               (value (cl-gensym "value-"))
               (default-value (cl-gensym "ert-form-evaluation-aborted-")))
-          `(let ((,fn (function ,fn-name))
-                 (,args (list ,@arg-forms)))
+          `(let* ((,fn (function ,fn-name))
+                  (,args (condition-case err
+                             (let ((signal-hook-function #'ert--signal-hook))
+                               (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))
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index 317838b250..b6a7eb68da 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -294,6 +294,15 @@ ert-self-test-and-exit
                   "the error signaled was a subtype of the expected type")))))
     ))
 
+(ert-deftest ert-test-should-error-argument ()
+  "Errors due to evaluating arguments should not break tests."
+  (should-error (identity (/ 1 0))))
+
+(ert-deftest ert-test-should-error-macroexpansion ()
+  "Errors due to expanding macros should not break tests."
+  (cl-macrolet ((test () (error "Foo")))
+    (should-error (test))))
+
 (ert-deftest ert-test-skip-unless ()
   ;; Don't skip.
   (let ((test (make-ert-test :body (lambda () (skip-unless t)))))