[nongnu] elpa/buttercup df7f98e110 03/16: Do not collect backtraces for failed specs

[ELPA Syncer]

branch: elpa/buttercup
commit df7f98e1102ee28f1f428caf7edb3576e1ddc0b3
Author: Ola Nilsson <ola.nilsson@gmail.com>
Commit: Ola Nilsson <ola.nilsson@gmail.com>

    Do not collect backtraces for failed specs
    
    There is no reason to collect backtraces for expect form where the
    matcher detects a mismatch.  It's all buttercup infrastructure at that
    point.
---
 buttercup.el            |  6 +++---
 tests/test-buttercup.el | 37 +++++++++++++++++++++----------------
 2 files changed, 24 insertions(+), 19 deletions(-)

diff --git a/buttercup.el b/buttercup.el
index d9c5a99d93..7f30f2c38d 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -2107,8 +2107,9 @@ ARGS according to `debugger'."
                ;; args is (error (signal . data) ....) where the tail
                ;; may be empty
                (cl-destructuring-bind (signal-type . data) (cl-second args)
-                 (unless (eq signal-type 'buttercup-pending)
-                   (buttercup--backtrace))))))
+                 (cl-case signal-type
+                   ((buttercup-pending buttercup-failed))
+                   (otherwise (buttercup--backtrace)))))))
 
 (defalias 'buttercup--mark-stackframe #'ignore
   "Marker to find where the backtrace start.")
@@ -2129,7 +2130,6 @@ ARGS according to `debugger'."
            ;; wrapped expressions of an expect.
            (buttercup--wrapper-fun-p (cadr frame))
            ;; TODO: error in `it' but outside `expect'
-           ;; TODO: matchers that do not match should not collect backtrace
            ;; TODO: What about an error in a matcher?
            ;; TODO: What about :to-throw?
            ;; TODO: What about signals in before and after blocks?
diff --git a/tests/test-buttercup.el b/tests/test-buttercup.el
index 31a9fbbd4f..e2ab163725 100644
--- a/tests/test-buttercup.el
+++ b/tests/test-buttercup.el
@@ -1969,22 +1969,27 @@ before it's processed by other functions."
        (fmakunbound 'bc-bt-foo)
        (fmakunbound 'bc-bt-bar)
        (fmakunbound 'bc-bt-baz))
-  (it "should be printed for each failed spec"
-    (with-local-buttercup
-      :reporter #'backtrace-reporter
-      (describe "suite"
-        (it "expect 2" (expect (+ 1 2) :to-equal 2))
-        (it "expect nil" (expect nil)))
-      (buttercup-run :noerror))
-    (expect (buttercup-output) :to-match
-            (rx string-start
-                (= 2 (seq (= 40 ?=) "\n"
-                          "suite expect " (or "2" "nil") "\n"
-                          "\n"
-                          "Traceback (most recent call last):\n"
-                          (* (seq "  " (+ not-newline) "\n"))
-                          (or "FAILED" "error") ": " (+ not-newline) "\n\n"))
-                string-end)))
+  (it "should not be collected or printed for failed specs"
+    (let (test-suites)
+      (spy-on 'buttercup--backtrace :and-call-through)
+      (with-local-buttercup
+       :reporter #'backtrace-reporter
+       (describe "suite"
+         (it "expect 2" (expect (+ 1 2) :to-equal 2))
+         (it "expect nil" (expect nil)))
+       (buttercup-run :noerror)
+       (setq test-suites buttercup-suites))
+      (expect 'buttercup--backtrace :not :to-have-been-called)
+      ;; Checking both if buttercup--backtrace have been called and
+      ;; the failure-stack value might be overkill
+      (expect (cl-every #'null
+                        (mapcar #'buttercup-spec-failure-stack
+                                (buttercup-suite-children (car test-suites)))))
+      (expect (buttercup-output) :to-match
+              (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