[nongnu] elpa/buttercup 162b862 060/340: The buttercup--funcall function.

[ELPA Syncer]

branch: elpa/buttercup
commit 162b862c603bed00637efdb88780d188df538307
Author: Jorgen Schaefer <contact@jorgenschaefer.de>
Commit: Jorgen Schaefer <contact@jorgenschaefer.de>

    The buttercup--funcall function.
---
 buttercup-test.el | 18 ++++++++++++++++++
 buttercup.el      | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 66 insertions(+)

diff --git a/buttercup-test.el b/buttercup-test.el
index 574c03b..12c859d 100644
--- a/buttercup-test.el
+++ b/buttercup-test.el
@@ -576,3 +576,21 @@
 
     (it "should handle the end event"
       (buttercup-reporter-batch 'buttercup-done nil))))
+
+;;;;;;;;;;;;;
+;;; Utilities
+
+(describe "The `buttercup--funcall' function'"
+  (it "should return passed if everything works fine"
+    (let ((res (buttercup--funcall (lambda () (+ 2 3)))))
+      (expect res
+              :to-equal
+              (list 'passed 5 nil))))
+
+  (it "should return failed with the correct stack if an exception occurred"
+    (let ((res (buttercup--funcall (lambda () (/ 1 0)))))
+      (expect res
+              :to-equal
+              (list 'failed
+                    '(error (arith-error))
+                    (list '(t / 1 0)))))))
diff --git a/buttercup.el b/buttercup.el
index 9012789..5f2ae75 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -707,5 +707,53 @@ buttercup-done -- All suites have run, the test run is 
over.")
     (t
      (error "Unknown event %s" event))))
 
+;;;;;;;;;;;;;
+;;; Utilities
+
+(defun buttercup--funcall (function &rest arguments)
+  "Call FUNCTION with ARGUMENTS.
+
+Returns a list of three values. The first is the state:
+
+passed -- The second value is the return value of the function
+  call, the third is nil.
+
+failed -- The second value is the error that occurred, the third
+  is the stack trace."
+  (catch 'buttercup-debugger-continue
+    (let ((debugger #'buttercup--debugger)
+          (debug-on-error t)
+          (debug-ignored-errors nil))
+      (list 'passed
+            (apply function arguments)
+            nil))))
+
+(defun buttercup--debugger (&rest args)
+  ;; If we do not do this, Emacs will not run this handler on
+  ;; subsequent calls. Thanks to ert for this.
+  (setq num-nonmacro-input-events (1+ num-nonmacro-input-events))
+  (throw 'buttercup-debugger-continue
+         (list 'failed args (buttercup--backtrace))))
+
+
+(defun buttercup--backtrace ()
+  (let* ((n 0)
+         (frame (backtrace-frame n))
+         (frame-list nil)
+         (in-program-stack nil))
+    (while frame
+      (when in-program-stack
+        (push frame frame-list))
+      (when (eq (elt frame 1)
+                'buttercup--debugger)
+        (setq in-program-stack t))
+      (when (eq (elt frame 1)
+                'buttercup--funcall)
+        (setq in-program-stack nil
+              frame-list (nthcdr 6 frame-list)))
+      (setq n (1+ n)
+            frame (backtrace-frame n)))
+    frame-list))
+
 (provide 'buttercup)
 ;;; buttercup.el ends here