branch: elpa/buttercup
commit c5a9f265087b04f06089568e5f4a268ae23d6a22
Author: Jorgen Schaefer <cont...@jorgenschaefer.de>
Commit: Jorgen Schaefer <cont...@jorgenschaefer.de>
Add first set of unit tests.
---
Makefile | 1 +
buttercup-test.el | 91 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
buttercup.el | 84 +++++++++++++++++++++++++++++++++++++++-----------
3 files changed, 159 insertions(+), 17 deletions(-)
diff --git a/Makefile b/Makefile
index 5fc7198..fc542ac 100644
--- a/Makefile
+++ b/Makefile
@@ -4,3 +4,4 @@ all: test
test:
emacs -batch -L . -l buttercup.el -f buttercup-markdown-runner README.md
+ emacs -batch -L . -l buttercup-test.el -f buttercup-run
diff --git a/buttercup-test.el b/buttercup-test.el
index a7296d6..0b123b9 100644
--- a/buttercup-test.el
+++ b/buttercup-test.el
@@ -1 +1,92 @@
(require 'buttercup)
+
+(describe "The buttercup-failed signal"
+ (it "can be raised"
+ (expect (lambda ()
+ (signal 'buttercup-failed t))
+ :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))
+ :to-equal
+ '(buttercup-expect (+ 1 1) :to-equal 2)))
+
+ (it "with a form argument should extract the matcher from the form"
+ (expect (macroexpand '(expect (equal (+ 1 1) 2)))
+ :to-equal
+ '(buttercup-expect (+ 1 1) #'equal 2)))
+
+ (it "with a single argument should pass it to the function"
+ (expect (macroexpand '(expect t))
+ :to-equal
+ '(buttercup-expect t))))
+
+(describe "The `buttercup-expect' function"
+ (describe "with a single argument"
+ (it "should not raise an error if the argument is true"
+ (expect (lambda ()
+ (buttercup-expect t))
+ :not :to-throw
+ 'buttercup-failed))
+
+ (it "should raise an error if the argument is false"
+ (expect (lambda ()
+ (buttercup-expect nil))
+ :to-throw
+ 'buttercup-failed
+ "Expected nil to be non-nil")))
+
+ (describe "with a function as a matcher argument"
+ (it "should not raise an error if the function returns true"
+ (expect (lambda ()
+ (buttercup-expect t #'eq t))
+ :not :to-throw
+ 'buttercup-failed))
+
+ (it "should raise an error if the function returns false"
+ (expect (lambda ()
+ (buttercup-expect t #'eq nil))
+ :to-throw
+ 'buttercup-failed)))
+
+ (describe "with a matcher argument"
+ (buttercup-define-matcher :always-true (a) t)
+ (buttercup-define-matcher :always-false (a) nil)
+
+ (it "should not raise an error if the matcher returns true"
+ (expect (lambda ()
+ (buttercup-expect 1 :always-true))
+ :not :to-throw
+ 'buttercup-failed))
+
+ (it "should raise an error if the matcher returns false"
+ (expect (lambda ()
+ (buttercup-expect 1 :always-false))
+ :to-throw
+ 'buttercup-failed))))
+
+(describe "The `buttercup-fail' function"
+ (it "should raise a signal with its arguments"
+ (expect (lambda ()
+ (buttercup-fail "Explanation" ))
+ :to-throw
+ 'buttercup-failed "Explanation")))
+
+(describe "The `buttercup-define-matcher' macro"
+ (it "should add a buttercup-matcher property"
+ (buttercup-define-matcher :test-matcher (a b)
+ (+ a b))
+
+ (expect (funcall (get :test-matcher 'buttercup-matcher)
+ 1 2)
+ :to-equal
+ 3)))
diff --git a/buttercup.el b/buttercup.el
index 4e6ad5b..4997e6d 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -38,29 +38,58 @@
(define-error 'buttercup-error
"Buttercup test raised an error")
-(defun expect (arg &optional matcher &rest args)
+(defmacro expect (arg &optional matcher &rest args)
+ "Expect a condition to be true.
+
+This macro knows three forms:
+
+\(expect arg :matcher args...)
+ Fail the current test iff the matcher does not match these arguments.
+ See `buttercup-define-matcher' for more information on matchers.
+
+\(expect (function arg...))
+ Fail the current test iff the function call does not return a true value.
+
+\(expect ARG)
+ Fail the current test iff ARG is not true."
+ (cond
+ ((and (not matcher)
+ (consp arg))
+ `(buttercup-expect ,(cadr arg)
+ #',(car arg)
+ ,@(cddr arg)))
+ ((and (not matcher)
+ (not (consp arg)))
+ `(buttercup-expect ,arg))
+ (t
+ `(buttercup-expect ,arg ,matcher ,@args))))
+
+(defun buttercup-expect (arg &optional matcher &rest args)
+ "The function for the `expect' macro.
+
+See the macro documentation for details."
(if (not matcher)
(when (not arg)
- (signal 'buttercup-failed
- (format "Expected %S to be non-nil" arg)))
+ (buttercup-fail "Expected %S to be non-nil" arg))
(let ((result (buttercup--apply-matcher matcher (cons arg args))))
(if (consp result)
(when (not (car result))
- (signal 'buttercup-failed
- (cdr result)))
+ (buttercup-fail "%s" (cdr result)))
(when (not result)
- (signal 'buttercup-failed
- (format "Expected %S %S %S"
+ (buttercup-fail "Expected %S %S %S"
arg
matcher
(mapconcat (lambda (obj)
(format "%S" obj))
args
- " "))))))))
+ " ")))))))
-(defun buttercup-fail (explanation form)
- (signal 'buttercup-failed (cons explanation
- form)))
+(defun buttercup-fail (format &rest args)
+ "Fail the current test with the given description.
+
+This is the mechanism underlying `expect'. You can use it
+directly if you want to write your own testing functionality."
+ (signal 'buttercup-failed (apply #'format format args)))
(defmacro buttercup-define-matcher (matcher args &rest body)
"Define a matcher to be used in `expect'.
@@ -75,6 +104,7 @@ should describe why a negated matcher failed."
,@body)))
(defun buttercup--apply-matcher (matcher args)
+
(let ((function (or (get matcher 'buttercup-matcher)
matcher)))
(when (not (functionp function))
@@ -133,13 +163,34 @@ should describe why a negated matcher failed."
(cons nil (format "Expected %S to be greater than %S to %s positions"
a b precision))))
-(buttercup-define-matcher :to-throw (function)
+(buttercup-define-matcher :to-throw (function &optional signal signal-args)
(condition-case err
(progn
(funcall function)
(cons nil (format "Expected %S to throw an error" function)))
(error
- (cons t (format "Expected %S not to throw an error" function)))))
+ (cond
+ ((and signal signal-args)
+ (cond
+ ((not (memq signal (get (car err) 'error-conditions)))
+ (cons nil (format "Expected %S to throw a child signal of %S, not %S"
+ function signal (car err))))
+ ((not (equal signal-args (cdr err)))
+ (cons nil (format "Expected %S to throw %S with args %S, not %S with
%S"
+ function signal signal-args (car err) (cdr err))))
+ (t
+ (cons t (format (concat "Expected %S not to throw a child signal "
+ "of %S with args %S, but it did throw %S")
+ function signal signal-args (car err))))))
+ (signal
+ (if (not (memq signal (get (car err) 'error-conditions)))
+ (cons nil (format "Expected %S to throw a child signal of %S, not
%S"
+ function signal (car err)))
+ (cons t (format (concat "Expected %S not to throw a child signal "
+ "of %S, but it threw %S")
+ function signal (car err)))))
+ (t
+ (cons t (format "Expected %S not to throw an error" function)))))))
;;;;;;;;;;;;;;;;;;;;
;;; describe: Suites
@@ -244,17 +295,16 @@ form.")
(defun buttercup-run-suite (suite &optional level)
(let* ((level (or level 0))
(indent (make-string (* 2 level) ?\s)))
- (message "%s%s\n" indent (buttercup-suite-description suite))
+ (message "%s%s" indent (buttercup-suite-description suite))
(dolist (sub (buttercup-suite-nested suite))
(cond
((buttercup-suite-p sub)
- (message "")
(buttercup-run-suite sub (1+ level)))
((buttercup-spec-p sub)
(message "%s%s"
(make-string (* 2 (1+ level)) ?\s)
- (buttercup-spec-description sub)))
- (funcall (buttercup-spec-function sub))))
+ (buttercup-spec-description sub))
+ (funcall (buttercup-spec-function sub)))))
(message "")))
(defun buttercup-markdown-runner ()
