branch: elpa/buttercup
commit e10955c62a8c38679bcb8430630b703e3d348425
Author: Jorgen Schaefer <cont...@jorgenschaefer.de>
Commit: Jorgen Schaefer <cont...@jorgenschaefer.de>
Initial commit.
---
Cask | 3 +
Makefile | 6 ++
README.md | 166 +++++++++++++++++++++++++++++++++
buttercup-test.el | 1 +
buttercup.el | 273 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 449 insertions(+)
diff --git a/Cask b/Cask
new file mode 100644
index 0000000..5cd3319
--- /dev/null
+++ b/Cask
@@ -0,0 +1,3 @@
+(source gnu)
+
+(development)
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..5fc7198
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,6 @@
+.PHONY: test
+
+all: test
+
+test:
+ emacs -batch -L . -l buttercup.el -f buttercup-markdown-runner README.md
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..23a1d26
--- /dev/null
+++ b/README.md
@@ -0,0 +1,166 @@
+# Buttercup — Behavior-Driven Emacs Lisp Testing
+
+Buttercup is a behavior-driven development framework for testing Emacs
+Lisp code. It is heavily inspired by
+[Jasmine](https://jasmine.github.io/). So heavily inspired, in fact,
+that half this page is more or less a verbatim copy of the
+[Jasmine introduction](https://jasmine.github.io/edge/introduction.html).
+
+All code in this file can be run by Buttercup’s built-in markdown test
+runner. Just use `make test` in the project directory to see the
+output.
+
+## Suites: `describe` Your Tests
+
+A test suite begins with a call to the Buttercup macro `describe` with
+the first parameter describing the suite and the rest being the body
+of code that implements the suite.
+
+```Lisp
+(describe "A suite"
+ (it "contains a spec with an expectation"
+ (expect t :to-be t)))
+```
+
+## Specs
+
+Specs are defined by calling the Buttercup macro `it`, which, like
+`describe` takes a string and code. The string is the title of the
+spec and the code is the spec, or test. A spec contains one or more
+expectations that test the state of the code. An expectation in
+Buttercup is an assertion that is either true or false. A spec with
+all true expectations is a passing spec. A spec with one or more false
+expectations is a failing spec.
+
+### It’s Just Functions
+
+The code arguments to `describe` and `it` is just turned into
+functions internally, so they can contain any executable code
+necessary to implement the rules. Emacs Lisp scoping rules apply, so
+make sure to define your spec file to be lexically scoped.
+
+```Lisp
+(describe "A suite is just a function"
+ (let ((a nil))
+ (it "and so is a spec"
+ (setq a t)
+ (expect a :to-be t))))
+```
+
+## Expectations
+
+Expectations are expressed with the `expect` function. Its first
+argument is the actual value. The second argument is a test, followed
+by expected values for the test to compare the actual value against.
+
+If there is no test, the argument is simply tested for being non-nil.
+This can be used by people who dislike the matcher syntax.
+
+### Matchers
+
+Each matcher implements a boolean comparison between the actual value
+and the expected value. It is responsible for reporting to Buttercup
+if the expectation is true or false. Buttercup will then pass or fail
+the spec.
+
+Any matcher can evaluate to a negative assertion by prepending it with
+the `:not` matcher.
+
+```Lisp
+(describe "The :to-be matcher compares with `eq'"
+ (it "and has a positive case"
+ (expect t :to-be t))
+ (it "and can have a negative case"
+ (expect nil :not :to-be t)))
+```
+
+### Included Matchers
+
+Buttercup has a rich set of matchers included. Each is used here — all
+expectations and specs pass. There is also the ability to write custom
+matchers (see the `buttercup-define-matcher` macro for further
+information) for when a project’s domain calls for specific assertions
+that are not included below.
+
+```Lisp
+(describe "Included matchers:"
+ (it "The :to-be matcher compares with `eq'"
+ (let* ((a 12)
+ (b a))
+ (expect a :to-be b)
+ (expect a :not :to-be nil)))
+
+ (describe "The :to-equal matcher"
+ (it "works for simple literals and variables"
+ (let ((a 12))
+ (expect a :to-equal 12)))
+
+ (it "should work for compound objects"
+ (let ((foo '((a . 12) (b . 34)))
+ (bar '((a . 12) (b . 34))))
+ (expect foo :to-equal bar))))
+
+ (it "The :to-match matcher is for regular expressions"
+ (let ((message "foo bar baz"))
+ (expect message :to-match "bar")
+ (expect message :to-match (rx "bar"))
+ (expect message :not :to-match "quux")))
+
+ (it "The :to-be-truthy matcher is for boolean casting testing"
+ (let (a
+ (foo "foo"))
+ (expect foo :to-be-truthy)
+ (expect a :not :to-be-truthy)))
+
+ (it "The :to-contain matcher is for finding an item in a list"
+ (let ((a '("foo" "bar" "baz")))
+ (expect a :to-contain "bar")
+ (expect a :not :to-contain "quux")))
+
+ (it "The :to-be-less-than matcher is for mathematical comparisons"
+ (let ((pi 3.1415926)
+ (e 2.78))
+ (expect e :to-be-less-than pi)
+ (expect pi :not :to-be-less-than e)))
+
+ (it "The :to-be-greater-than matcher is for mathematical comparisons"
+ (let ((pi 3.1415926)
+ (e 2.78))
+ (expect pi :to-be-greater-than e)
+ (expect e :not :to-be-greater-than pi)))
+
+ (it "The :to-be-close-to matcher is for precision math comparison"
+ (let ((pi 3.1415926)
+ (e 2.78))
+ (expect pi :not :to-be-close-to e 2)
+ (expect pi :to-be-close-to e 0)))
+
+ (it "The :to-throw matcher is for testing if a function throws an exception"
+ (let ((foo (lambda () (+ 1 2)))
+ (bar (lambda () (+ a 1))))
+ (expect foo :not :to-throw)
+ (expect bar :to-throw))))
+```
+
+## Spies
+
+Buttercup provides a way of _spying_ on a function, something usually
+called mocking, but Jasmine calls it _spies_, and so do we. Did I
+mention Buttercup is heavily inspired by Jasmine?
+
+## Test Runners
+
+Evaluating `describe` forms just stores the suites. You need to use a
+test runner to actually evaluate them. Buttercup comes with two test
+runners by default:
+
+- `buttercup-run-suite-at-point` — Evaluate the topmost `describe`
+ form at point and run the suite it creates directly. Useful for
+ interactive development. But be careful, this uses your current
+ environment, which might not be clean (due to said interactive
+ development).
+- `buttercup-discover` — Find files in directories specified on the
+ command line, load them, and then run all suites defined therein.
+ Useful for being run in batch mode.
+- `buttercup-markdown-runner` — Run code in markdown files. Used to
+ run this file’s code.
diff --git a/buttercup-test.el b/buttercup-test.el
new file mode 100644
index 0000000..a7296d6
--- /dev/null
+++ b/buttercup-test.el
@@ -0,0 +1 @@
+(require 'buttercup)
diff --git a/buttercup.el b/buttercup.el
new file mode 100644
index 0000000..d146d1f
--- /dev/null
+++ b/buttercup.el
@@ -0,0 +1,273 @@
+;;; buttercup.el --- Behavior-Driven Emacs Lisp Testing
+
+;; Copyright (C) 2015 Jorgen Schaefer <cont...@jorgenschaefer.de>
+
+;; Version: 0.1
+;; Author: Jorgen Schaefer <cont...@jorgenschaefer.de>
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License
+;; as published by the Free Software Foundation; either version 3
+;; of the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The ideas for project were shamelessly taken from Jasmine
+;; <https://jasmine.github.io>.
+
+;; All the good ideas are theirs. All the problems are mine.
+
+;;; Code:
+
+(require 'cl)
+
+;;;;;;;;;;
+;;; expect
+
+(define-error 'buttercup-failed
+ "Buttercup test failed")
+
+(define-error 'buttercup-error
+ "Buttercup test raised an error")
+
+(defun expect (arg &optional matcher &rest args)
+ (if (not matcher)
+ (when (not arg)
+ (signal 'buttercup-failed
+ (format "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)))
+ (when (not result)
+ (signal 'buttercup-failed
+ (format "Expected %S %S %S"
+ arg
+ matcher
+ (mapconcat (lambda (obj)
+ (format "%S" obj))
+ args
+ " "))))))))
+
+(defun buttercup-fail (explanation form)
+ (signal 'buttercup-failed (cons explanation
+ form)))
+
+(defmacro buttercup-define-matcher (matcher args &rest body)
+ "Define a matcher to be used in `expect'.
+
+The BODY should return either a simple boolean, or a cons cell of
+the form (RESULT . MESSAGE). If RESULT is nil, MESSAGE should
+describe why the matcher failed. If RESULT is non-nil, MESSAGE
+should describe why a negated matcher failed."
+ (declare (indent defun))
+ `(put ,matcher 'buttercup-matcher
+ (lambda ,args
+ ,@body)))
+
+(defun buttercup--apply-matcher (matcher args)
+ (let ((function (or (get matcher 'buttercup-matcher)
+ matcher)))
+ (when (not (functionp function))
+ (error "Not a test: %S" matcher))
+ (apply function args)))
+
+(buttercup-define-matcher :not (obj matcher &rest args)
+ (let ((result (buttercup--apply-matcher matcher (cons obj args))))
+ (if (consp result)
+ (cons (not (car result))
+ (cdr result))
+ (not result))))
+
+(buttercup-define-matcher :to-be (a b)
+ (if (eq a b)
+ (cons t (format "Expected %S not to be `eq' to %S" a b))
+ (cons nil (format "Expected %S to be `eq' to %S" a b))))
+
+(buttercup-define-matcher :to-equal (a b)
+ (if (equal a b)
+ (cons t (format "Expected %S not to `equal' %S" a b))
+ (cons nil (format "Expected %S to `equal' %S" a b))))
+
+(buttercup-define-matcher :to-match (text regexp)
+ (if (string-match regexp text)
+ (cons t (format "Expected %S to match the regexp %S"
+ text regexp))
+ (cons nil (format "Expected %S not to match the regexp %S"
+ text regexp))))
+
+(buttercup-define-matcher :to-be-truthy (arg)
+ (if arg
+ (cons t (format "Expected %S not to be true" arg))
+ (cons nil (format "Expected %S to be true" arg))))
+
+(buttercup-define-matcher :to-contain (seq elt)
+ (if (member elt seq)
+ (cons t (format "Expected %S not to contain %S" seq elt))
+ (cons nil (format "Expected %S to contain %S" seq elt))))
+
+(buttercup-define-matcher :to-be-less-than (a b)
+ (if (< a b)
+ (cons t (format "Expected %S not to be less than %S" a b))
+ (cons nil (format "Expected %S to be less than %S" a b))))
+
+(buttercup-define-matcher :to-be-greater-than (a b)
+ (if (> a b)
+ (cons t (format "Expected %S not to be greater than %S" a b))
+ (cons nil (format "Expected %S to be greater than %S" a b))))
+
+(buttercup-define-matcher :to-be-close-to (a b precision)
+ (if (< (abs (- a b))
+ (/ 1 (expt 10.0 precision)))
+ (cons t (format "Expected %S not to be close to %S to %s positions"
+ a b precision))
+ (cons nil (format "Expected %S to be greater than %S to %s positions"
+ a b precision))))
+
+(buttercup-define-matcher :to-throw (function)
+ (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)))))
+
+;;;;;;;;;;
+;;; Suites
+
+(cl-defstruct buttercup-suite
+ description
+ nested
+ specs)
+
+(defun buttercup-suite-add-nested (parent child)
+ "Add a CHILD suite as a nested suite to a PARENT suite."
+ (setf (buttercup-suite-nested parent)
+ (append (buttercup-suite-nested parent)
+ (list child))))
+
+;;;;;;;;;;;;
+;;; describe
+
+(defvar buttercup-suites nil
+ "The list of all currently defined Buttercup suites.")
+
+(defvar buttercup--current-suite nil
+ "The suite currently being defined.
+
+Do not set this globally. It is let-bound by the `describe'
+form.")
+
+(defmacro describe (description &rest body)
+ "Describe a suite of tests."
+ (declare (indent 1))
+ `(buttercup--describe-internal ,description (lambda () ,@body)))
+
+(defun buttercup--describe-internal (description body-function)
+ "Function to handle a `describe' form."
+ (let* ((enclosing-suite buttercup--current-suite)
+ (buttercup--current-suite (make-buttercup-suite
+ :description description)))
+ (funcall body-function)
+ (if enclosing-suite
+ (buttercup-suite-add-nested enclosing-suite
+ buttercup--current-suite)
+ (setq buttercup-suites (append buttercup-suites
+ (list buttercup--current-suite))))))
+
+;;;;;;
+;;; it
+
+(defmacro it (description &rest body)
+ "Define a spec."
+ (declare (indent 1))
+ `(buttercup--it-internal ,description (lambda () ,@body)))
+
+(defun buttercup--it-internal (description body-function)
+ "Function to handle an `it' form."
+ (when (not description)
+ (error "`it' has to be called from within a `describe' form."))
+ (buttercup-suite-add-nested buttercup--current-suite
+ (cons description
+ body-function)))
+
+;; (let* ((buttercup--descriptions (cons description
+;; buttercup--descriptions))
+;; (debugger (lambda (&rest args)
+;; (let ((backtrace (buttercup--backtrace)))
+;; ;; If we do not do this, Emacs will not this
+;; ;; handler on subsequent calls. Thanks to ert
+;; ;; for this.
+;; (cl-incf num-nonmacro-input-events)
+;; (signal 'buttercup-error (cons args backtrace)))))
+;; (debug-on-error t)
+;; (debug-ignored-errors '(buttercup-failed buttercup-error)))
+;; (buttercup-report 'enter nil buttercup--descriptions)
+;; (condition-case sig
+;; (progn
+;; (funcall body-function)
+;; (buttercup-report 'success nil buttercup--descriptions))
+;; (buttercup-failed
+;; (buttercup-report 'failure (cdr sig) buttercup--descriptions))
+;; (buttercup-error
+;; (buttercup-report 'error (cdr sig) buttercup--descriptions))))
+
+;; (defun buttercup--backtrace ()
+;; (let* ((n 5)
+;; (frame (backtrace-frame n))
+;; (frame-list nil))
+;; (while frame
+;; (push frame frame-list)
+;; (setq n (1+ n)
+;; frame (backtrace-frame n)))
+;; frame-list))
+
+;;;;;;;;;;;;;;;;
+;;; Test Runners
+
+(defun buttercup-run ()
+ (if buttercup-suites
+ (mapc #'buttercup-run-suite buttercup-suites)
+ (error "No suites defined")))
+
+(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))
+ (dolist (sub (buttercup-suite-nested suite))
+ (if (buttercup-suite-p sub)
+ (progn
+ (message "")
+ (buttercup-run-suite sub (1+ level)))
+ (message "%s%s"
+ (make-string (* 2 (1+ level)) ?\s)
+ (car sub))
+ (funcall (cdr sub))))
+ (message "")))
+
+(defun buttercup-markdown-runner ()
+ (let ((lisp-buffer (generate-new-buffer "elisp")))
+ (dolist (file command-line-args-left)
+ (with-current-buffer (find-file-noselect file)
+ (goto-char (point-min))
+ (while (re-search-forward "```lisp\n\\(\\(?:.\\|\n\\)*?\\)```"
+ nil t)
+ (let ((code (match-string 1)))
+ (with-current-buffer lisp-buffer
+ (insert code))))))
+ (with-current-buffer lisp-buffer
+ (setq lexical-binding t)
+ (eval-buffer))
+ (buttercup-run)))
+
+(provide 'buttercup)
+;;; buttercup.el ends here
