branch: elpa/buttercup
commit 638a8362227e63b2802f992e0c1d14224d261262
Author: Jorgen Schaefer <cont...@jorgenschaefer.de>
Commit: Jorgen Schaefer <cont...@jorgenschaefer.de>
The batch reporter now displays failures and stack traces.
---
buttercup-test.el | 71 +++++++++++++++++++------------
buttercup.el | 125 ++++++++++++++++++++++++++++++++++++++++--------------
2 files changed, 136 insertions(+), 60 deletions(-)
diff --git a/buttercup-test.el b/buttercup-test.el
index 12c859d..eb24062 100644
--- a/buttercup-test.el
+++ b/buttercup-test.el
@@ -29,13 +29,6 @@
:to-throw
'buttercup-failed)))
-(describe "The buttercup-error signal"
- (it "can be raised"
- (expect (lambda ()
- (signal 'buttercup-error t))
- :to-throw
- 'buttercup-error)))
-
(describe "The `expect' form"
(it "with a matcher should translate directly to the function call"
(expect (macroexpand '(expect (+ 1 1) :to-equal 2))
@@ -208,6 +201,21 @@
:to-equal
2))))
+(describe "The `buttercup-suites-total-specs-failed' function"
+ (it "should return the number of failed specs in a list of suites"
+ (let ((su1 (make-buttercup-suite :description "su1"))
+ (su2 (make-buttercup-suite :description "su2"))
+ (sp1 (make-buttercup-spec :description "sp1"))
+ (sp2 (make-buttercup-spec :description "sp2"
+ :status 'failed)))
+ (buttercup-suite-add-child su1 su2)
+ (buttercup-suite-add-child su1 sp1)
+ (buttercup-suite-add-child su2 sp2)
+
+ (expect (buttercup-suites-total-specs-failed (list su1))
+ :to-equal
+ 1))))
+
(describe "The `buttercup-suite-full-name' function"
(let (su1 su2)
(before-each
@@ -538,7 +546,7 @@
spec (make-buttercup-spec :description "spec"))
(buttercup-suite-add-child parent-suite child-suite)
(buttercup-suite-add-child child-suite spec)
- (spy-on 'message))
+ (spy-on 'buttercup--print))
(it "should handle the start event"
(buttercup-reporter-batch 'buttercup-started nil))
@@ -546,18 +554,18 @@
(it "should emit an indented suite description on suite start"
(buttercup-reporter-batch 'suite-started child-suite)
- (expect 'message
+ (expect 'buttercup--print
:to-have-been-called-with
- "%s%s"
+ "%s%s\n"
" "
"child-suite"))
(it "should emit an indented spec description on spec start"
(buttercup-reporter-batch 'spec-started spec)
- (expect 'message
+ (expect 'buttercup--print
:to-have-been-called-with
- "%s%s"
+ "%s%s\n"
" "
"spec"))
@@ -567,12 +575,12 @@
(it "should emit a newline at the end of the top-level suite"
(buttercup-reporter-batch 'suite-done parent-suite)
- (expect 'message :to-have-been-called-with ""))
+ (expect 'buttercup--print :to-have-been-called-with "\n"))
(it "should not emit anything at the end of other suites"
(buttercup-reporter-batch 'suite-done child-suite)
- (expect 'message :not :to-have-been-called))
+ (expect 'buttercup--print :not :to-have-been-called))
(it "should handle the end event"
(buttercup-reporter-batch 'buttercup-done nil))))
@@ -580,17 +588,24 @@
;;;;;;;;;;;;;
;;; 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)))))))
+;; We can't test `buttercup--funcall' with buttercup, because the way
+;; we get the backtrace from Emacs does not nest.
+
+(let ((res (buttercup--funcall (lambda () (+ 2 3)))))
+ (when (not (equal res (list 'passed 5 nil)))
+ (error "Expected passing buttercup--funcall not to return %S"
+ res)))
+
+(let ((res (buttercup--funcall (lambda () (buttercup-fail "Bla")))))
+ (when (not (equal res (list 'failed
+ "Bla"
+ nil)))
+ (error "Expected failing buttercup--funcall not to return %S"
+ res)))
+
+(let ((res (buttercup--funcall (lambda () (/ 1 0)))))
+ (when (not (equal res (list 'error
+ '(error (arith-error))
+ (list '(t / 1 0)))))
+ (error "Expected erroring buttercup--funcall not to return %S"
+ res)))
diff --git a/buttercup.el b/buttercup.el
index 5f2ae75..a5c65b8 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -48,9 +48,6 @@
(define-error 'buttercup-failed
"Buttercup test failed")
-(define-error 'buttercup-error
- "Buttercup test raised an error")
-
(defmacro expect (arg &optional matcher &rest args)
"Expect a condition to be true.
@@ -215,20 +212,36 @@ MATCHER is either a matcher defined with
;;; Suite and spec data structures
(cl-defstruct buttercup-suite
+ ;; The name of this specific suite
description
+ ;; Any children of this suite, both suites and specs
children
+ ;; The parent of this suite, another suite
parent
+ ;; Closure to run before and after each spec in this suite and its
+ ;; children
before-each
after-each
+ ;; Likewise, but before and after all specs.
before-all
- after-all)
+ after-all
+ ;; These are set if there are errors in after-all.
+ ;; One of: passed failed pending
+ status
+ failure-description
+ failure-stack)
-;; Have to define the spec up here instead of with the specs where it
-;; belongs because we `setf' to it here.
(cl-defstruct buttercup-spec
+ ;; The description of the it form this was generated from
description
+ ;; The suite this spec is a member of
parent
- function)
+ ;; The closure to run for this spec
+ function
+ ;; One of: passed failed pending
+ status
+ failure-description
+ failure-stack)
(defun buttercup-suite-add-child (parent child)
"Add a CHILD suite to a PARENT suite."
@@ -258,17 +271,32 @@ MATCHER is either a matcher defined with
(defun buttercup-suites-total-specs-defined (suite-list)
"Return the number of specs defined in all suites in SUITE-LIST."
(let ((nspecs 0))
- (dolist (suite suite-list)
- (setq nspecs (+ nspecs
- (buttercup--total-specs-defined suite))))
+ (dolist (spec-or-suite (buttercup--specs-and-suites suite-list))
+ (when (buttercup-spec-p spec-or-suite)
+ (setq nspecs (1+ nspecs))))
+ nspecs))
+
+(defun buttercup-suites-total-specs-failed (suite-list)
+ "Return the number of failed specs in all suites in SUITE-LIST."
+ (let ((nspecs 0))
+ (dolist (spec-or-suite (buttercup--specs-and-suites suite-list))
+ (when (and (buttercup-spec-p spec-or-suite)
+ (eq (buttercup-spec-status spec-or-suite) 'failed))
+ (setq nspecs (1+ nspecs))))
nspecs))
-(defun buttercup--total-specs-defined (suite-or-spec)
+(defun buttercup--specs-and-suites (spec-or-suite-list)
"Return the number of specs defined in SUITE-OR-SPEC and its children."
- (if (buttercup-spec-p suite-or-spec)
- 1
- (apply #'+ (mapcar #'buttercup--total-specs-defined
- (buttercup-suite-children suite-or-spec)))))
+ (let ((specs-and-suites nil))
+ (dolist (spec-or-suite spec-or-suite-list)
+ (setq specs-and-suites (append specs-and-suites
+ (list spec-or-suite)))
+ (when (buttercup-suite-p spec-or-suite)
+ (setq specs-and-suites
+ (append specs-and-suites
+ (buttercup--specs-and-suites
+ (buttercup-suite-children spec-or-suite))))))
+ specs-and-suites))
(defun buttercup-suite-full-name (suite)
"Return the full name of SUITE, which includes the names of the parents."
@@ -624,8 +652,7 @@ Do not change the global value.")
(let* ((buttercup--before-each (append buttercup--before-each
(buttercup-suite-before-each suite)))
(buttercup--after-each (append (buttercup-suite-after-each suite)
- buttercup--after-each))
- (debug-on-error t))
+ buttercup--after-each)))
(funcall buttercup-reporter 'suite-started suite)
(dolist (f (buttercup-suite-before-all suite))
(funcall f))
@@ -644,7 +671,13 @@ Do not change the global value.")
(buttercup--with-cleanup
(dolist (f buttercup--before-each)
(funcall f))
- (funcall (buttercup-spec-function spec))
+ (let ((res (buttercup--funcall (buttercup-spec-function spec))))
+ (setf (buttercup-spec-status spec)
+ (elt res 0))
+ (setf (buttercup-spec-failure-description spec)
+ (elt res 1))
+ (setf (buttercup-spec-failure-stack spec)
+ (elt res 2)))
(dolist (f buttercup--after-each)
(funcall f)))
(funcall buttercup-reporter 'spec-done spec))
@@ -680,33 +713,59 @@ buttercup-done -- All suites have run, the test run is
over.")
(defun buttercup-reporter-batch (event arg)
(pcase event
(`buttercup-started
- t)
+ (buttercup--print "Running %s specs.\n\n"
+ (buttercup-suites-total-specs-defined arg)))
(`suite-started
(let ((level (length (buttercup-suite-parents arg))))
- (message "%s%s"
- (make-string (* 2 level) ?\s)
- (buttercup-suite-description arg))))
+ (buttercup--print "%s%s\n"
+ (make-string (* 2 level) ?\s)
+ (buttercup-suite-description arg))))
(`spec-started
(let ((level (length (buttercup-spec-parents arg))))
- (message "%s%s"
- (make-string (* 2 level) ?\s)
- (buttercup-spec-description arg))))
+ (buttercup--print "%s%s\n"
+ (make-string (* 2 level) ?\s)
+ (buttercup-spec-description arg))))
(`spec-done
- t)
+ (cond
+ ((eq (buttercup-spec-status arg) 'passed)
+ t)
+ ((eq (buttercup-spec-status arg) 'failed)
+ (let ((description (buttercup-spec-failure-description arg))
+ (stack (buttercup-spec-failure-stack arg)))
+ (when stack
+ (buttercup--print "\nTraceback (most recent call last):\n")
+ (dolist (frame stack)
+ (buttercup--print " %S\n" (cdr frame))))
+ (if (stringp description)
+ (buttercup--print "FAILED: %s\n"
+ (buttercup-spec-failure-description arg))
+ (buttercup--print "%S: %S\n\n" (car err) (cdr err)))
+ (buttercup--print "\n")))
+ (t
+ (buttercup--print "??? %S\n" (buttercup-spec-status arg)))))
(`suite-done
(when (= 0 (length (buttercup-suite-parents arg)))
- (message "")))
+ (buttercup--print "\n")))
(`buttercup-done
- t)
+ (buttercup--print "Ran %s specs, %s failed.\n"
+ (buttercup-suites-total-specs-defined arg)
+ (buttercup-suites-total-specs-failed arg)
+ )
+ (when (> (buttercup-suites-total-specs-failed arg) 0)
+ (error "")))
(t
(error "Unknown event %s" event))))
+(defun buttercup--print (fmt &rest args)
+ (let ((print-escape-newlines t))
+ (princ (apply #'format fmt args))))
+
;;;;;;;;;;;;;
;;; Utilities
@@ -718,8 +777,8 @@ 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."
+failed -- The second value is the description of the expectation
+ which failed or the error, the third is the backtrace or nil."
(catch 'buttercup-debugger-continue
(let ((debugger #'buttercup--debugger)
(debug-on-error t)
@@ -733,8 +792,10 @@ failed -- The second value is the error that occurred, the
third
;; 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))))
-
+ (if (and (eq (elt args 0) 'error)
+ (eq (car (elt args 1)) 'buttercup-failed))
+ (list 'failed (cdr (elt args 1)) nil)
+ (list 'error args (buttercup--backtrace)))))
(defun buttercup--backtrace ()
(let* ((n 0)
