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

[Alex <agrambot@gmail.com>]

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

tags 24402 patch
quit

Alex <agrambot@gmail.com> writes:

> Gemini Lasswell <gazally@runbox.com> writes:
>
>> I’ve done some investigating of why this is happening. testcover-start
>> transforms:
>>     (should-error (my-error))
>> into:
>>     (should-error (testcover-after 2 (my-error)))
>>
>> Then the macro expansion of should-error separates the form which it
>> is passed into a function symbol and list of arguments, and applies
>> the function to the arguments inside of a condition-case that traps
>> errors. The problem is that the arguments are evaluated first, outside
>> of the condition-case, so errors in their evaluation do not get
>> caught. This problem is not specific to testcover. In this example,
>> the first test passes and the second fails:
>>
>> (defun div-by (n)
>>   (/ 100 n))
>>
>> (defmacro log-div-by (n)
>>   `(message "div-by: %d" (div-by ,n)))
>>
>> (ert-deftest test-div-by ()
>>   (should-error (div-by 0)))
>>
>> (ert-deftest test-log-div-by ()
>>   (should-error (log-div-by 0)))
>>   
>
> I just ran into this as well. Consider these two forms:
>
> (should-error (cl-fourth "1234") :type 'wrong-type-argument)
>
> (should-error (car (cdr (cdr (cdr "1234")))) :type 'wrong-type-argument)
>
> Only the second raises an error, even though cl-fourth is equivalent to
> the car/cdr chain.

Here's a diff that appears to fix this. It's a bit crude, but I'd rather
not mess around too much with ert's internals.


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

diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 2c49a634e3..f5f3e30c0d 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -303,8 +303,12 @@ 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
+                             (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))

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


There's a similar issue with macro-expansions inside of
should/should-error/should-not that could/should be fixed by wrapping
the macroexpand call at the top of ert--expand-should-1 in a similar
condition-case. Here's another diff that does just that:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: second --]
[-- Type: text/x-diff, Size: 2316 bytes --]

diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index eb2b2e3e11..66ae31fd51 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -276,13 +276,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 +305,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
+                             (list ,@arg-forms)
+                           ;; (ert-test-failed (signal (car err) (cdr err)))
+                           (error (progn (setq ,fn #'signal)
+                                         (list (car err)
+                                               (cdr err)))))))
              (let ((,value ',default-value))
                ,(funcall inner-expander
                          `(setq ,value (apply ,fn ,args))

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


I ran "make check" and found only one test that the above diff breaks:
ert-test-test-result-expected-p.

I can't seem to figure out why it doesn't work. The test fails because
of these two:

(let ((test (make-ert-test :body (lambda () (ert-fail "failed")))))
  (should-not (ert-test-result-expected-p test (ert-run-test test))))
(let ((test (make-ert-test :body (lambda () (ert-fail "failed"))
                           :expected-result-type ':failed)))
  (should (ert-test-result-expected-p test (ert-run-test test))))

I tried to re-throw the ert-test-failed signal and still the above two
forms raise error an error.