branch: elpa/buttercup
commit 162b862c603bed00637efdb88780d188df538307
Author: Jorgen Schaefer <cont...@jorgenschaefer.de>
Commit: Jorgen Schaefer <cont...@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
