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