[nongnu] elpa/buttercup e10955c 001/340: Initial commit.

[ELPA Syncer]

branch: elpa/buttercup
commit e10955c62a8c38679bcb8430630b703e3d348425
Author: Jorgen Schaefer <contact@jorgenschaefer.de>
Commit: Jorgen Schaefer <contact@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 <contact@jorgenschaefer.de>
+
+;; Version: 0.1
+;; Author: Jorgen Schaefer <contact@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