diff --git a/buttercup.el b/buttercup.el index 037c6fc..77ee068 100644 --- a/buttercup.el +++ b/buttercup.el @@ -2129,15 +2129,19 @@ ARGS according to `debugger'." ;; When the error occurs in the calling of one of the ;; wrapped expressions of an expect. (buttercup--wrapper-fun-p (cadr frame)) - ;; TODO: When an error happens in code called outside an expect + ;; When an error happens in code called outside an expect ;; buttercup--update-with-funcall ;; apply buttercup--funcall ;; buttercup--funcall - sets debugger ;; apply FUNCTION ;; FUNCTION -- spec body function ;; condition-case -- from buttercup-with-converted-ert-signals - ;; progn -- the same + ;; (let ((buttercup--stackframe-marker 1)) -- the same ;; ACTUAL CODE + (and (null (car frame)) + (eq 'let (cadr frame)) + (equal '((buttercup--stackframe-marker 1)) (caddr frame)) + ) ;; TODO: What about an error in a matcher? ;; TODO: What about :to-throw? ;; TODO: What about signals in before and after blocks? @@ -2192,7 +2196,9 @@ Specifically, `ert-test-failed' is converted to `buttercup-pending'." (declare (indent 0)) `(condition-case err - (progn ,@body) + (let ((buttercup--stackframe-marker 1)) + (ignore buttercup--stackframe-marker) + ,@body) (ert-test-failed (buttercup-fail "%S" err)) (ert-test-skipped diff --git a/tests/test-buttercup.el b/tests/test-buttercup.el index 2c3ddc8..3eddd2f 100644 --- a/tests/test-buttercup.el +++ b/tests/test-buttercup.el @@ -1988,14 +1988,10 @@ before it's processed by other functions." collect (buttercup-spec-failure-stack spec) into stacks finally (expect stacks :to-be nil)) (expect (buttercup-output) :to-match - (rx-let ((failure-report (name) - (seq (= 40 ?=) "\n" - "suite expect " name "\n" - "FAILED: " (+ not-newline) "\n\n"))) - (rx string-start - (failure-report "2") - (failure-report "nil") - string-end))))) + (rx string-start + (= 40 ?=) "\nsuite expect " "2" "\nFAILED: " (+ not-newline) "\n\n" + (= 40 ?=) "\nsuite expect " "nil" "\nFAILED: " (+ not-newline) "\n\n" + string-end)))) (describe "with style" :var (test-suites long-string) ;; Set up tests to test