From b7f6d6839aadb0c0864ccce84c92c991f4721cb0 Mon Sep 17 00:00:00 2001
From: Chris Barrett <chris@walrus.cool>
Date: Wed, 27 Dec 2023 23:44:27 +1300
Subject: [PATCH] Add bdd-ert

---
 Readme.org      |   3 +
 lisp/ert-bdd.el | 246 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 249 insertions(+)
 create mode 100644 lisp/ert-bdd.el

diff --git a/Readme.org b/Readme.org
index f1c704f..dcad837 100644
--- a/Readme.org
+++ b/Readme.org
@@ -73,6 +73,9 @@ backlinks or reflinks.
 ** SPIKE [[file:lisp/org-format.el][org-format]] (/spike/)
 Formatter for org-mode files to ensure consistency.
 
+** SPIKE [[file:lisp/ert-bdd.el][ert-bdd]] (/spike/)
+BDD-style test syntax for ERT.
+
 * Installation
 Most packages should be manually installable via =package.el=, assuming you have
 [[https://melpa.org/#/getting-started][MELPA]] set up. But honestly, you're better off just cloning this repo and putting
diff --git a/lisp/ert-bdd.el b/lisp/ert-bdd.el
new file mode 100644
index 0000000..2b76bd5
--- /dev/null
+++ b/lisp/ert-bdd.el
@@ -0,0 +1,246 @@
+;;; ert-bbd.el --- BBD-style syntax for ERT -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Provides a nicer syntax for defining tests to run via ERT. It uses similar
+;; BDD-style tests to `buttercup', but since it uses ERT it is better-suited to
+;; interactive development.
+;;
+;; The main functions are:
+;;
+;;   - `+describe' which encloses a series of tests, and
+;;
+;;   - `+it', which describes a test cases--usually a single assertion using
+;;     ert's `should', `should-not', `should-error', etc.
+
+;;; Code:
+
+(require 'cl-lib)
+
+(autoload 'ert-deftest "ert")
+
+;;; HACK: Initially define no-op so tests can be defined inline.
+
+(cl-eval-when (compile load eval)
+  (unless (macrop 'ert-bdd)
+    (defmacro ert-bdd (&rest _))))
+
+
+;; Since the macro is the primary autoloaded entrypoint, the functions it uses
+;; must be evaluated when byte-compiling.
+
+(eval-and-compile
+  (defun ert-bdd--render-test-name (desc-stack)
+    "Build a test name, as a symbol, from a stack of descriptions.
+
+DESC-STACK is a list of descriptions collected from surrounding
+`+describe' and `+it' forms."
+
+    (when (null desc-stack)
+      (error "Input must be non-empty"))
+
+    (let* ((ordered (seq-reverse (seq-map (lambda (+it) (format "%s" +it)) desc-stack)))
+           (transformed (string-replace " " "-"
+                                        (string-join ordered "--"))))
+      (intern transformed)))
+
+  (defun ert-bdd-compile (form &optional inside-it-p)
+    (cl-labels ((compile (form desc-stack inside-it-p)
+                  (pcase form
+
+                    (`(+it ,desc . ,body)
+
+                     ;; (when inside-it-p
+                     ;;   (error "Cannot write an `+it' inside another `+it'"))
+
+                     (cl-assert (or (stringp desc) (symbolp desc)))
+
+                     `(ert-deftest ,(ert-bdd--render-test-name (cons desc desc-stack)) ()
+                        ,@(seq-map (lambda (it) (compile it nil t))
+                                   body)))
+
+
+                    (`(+describe ,desc . ,body)
+
+                     ;; (when inside-it-p
+                     ;;   (error "Cannot write a `+describe' inside an `+it'"))
+
+                     (cl-assert (or (stringp desc) (symbolp desc)))
+
+                     (let* ((new-stack (cons desc desc-stack))
+                            (new-body (seq-map (lambda (it) (compile it new-stack nil)) body)))
+                       (pcase new-body
+                         (`()     nil)
+                         (`(,x)   x)
+                         (xs      `(progn ,@xs)))))
+
+                    ((pred listp)
+                     (seq-map (lambda (it) (compile it desc-stack inside-it-p))
+                              form))
+
+                    (_
+                     form))))
+      (compile form nil inside-it-p))))
+
+
+;;;###autoload
+(defmacro +describe (desc &rest forms)
+  "Declare a suite of ERT tests using BDD syntax.
+
+DESC is a description of the test suite--either a symbol or a
+string.
+
+Within FORMS, you may use additional BDD-style `+describe' forms
+to build up a hierarchy of tests. Tests within these blocks are
+declared using `+it'.
+
+For example:
+
+\(+describe \"arithmetic operations\"
+  (let ((input 100))
+    (+describe \"addition\"
+      (+it \"has an identity (zero)\"
+        (should (equal (+ 0 input) input))))
+
+    ;; etc...
+    ))
+
+Tests will be excluded from byte-compiled output."
+  (declare (indent 1))
+  (unless load-file-name
+    (ert-bdd-compile `(+describe ,desc ,@forms))))
+
+;;;###autoload
+(defmacro +it (desc &rest forms)
+  "An ERT test case using BDD syntax.
+
+DESC is a description of the test case--either a symbol or a
+string. It will be concatenated with the descriptions from
+enclosing `+describe' forms.
+
+FORMS are the implementation of the test, and should use ert
+macros like `should', `should-not' and `should-error'.
+
+Tests will be excluded from byte-compiled output."
+  (declare (indent 1))
+  (unless load-file-name
+    (ert-bdd-compile `(+it ,desc ,@forms) t)))
+
+
+;;; Tests - nothing like a bit of dogfooding!
+
+(+describe ert-bdd-render-test-name
+
+  (+describe "empty stack"
+    (+it "errors"
+      (should-error (ert-bdd--render-test-name nil))))
+
+  (+describe "one string element in stack"
+    (+it "renders that element"
+      (should (equal (ert-bdd--render-test-name '("input"))
+                     'input))))
+
+  (+describe "mix of symbols and strings in stack"
+    (+it "renders those element"
+      (should (equal (ert-bdd--render-test-name '("a" b "c"))
+                     'c--b--a))))
+
+  (+describe "input sanitisation"
+    (+it "converts spaces to dashes"
+      (should (equal (ert-bdd--render-test-name '("a b"))
+                     'a-b)))))
+
+
+(+describe ert-bdd-compile
+
+  (+describe "input is a `+describe'"
+
+    (+describe "no body forms"
+      (+it "has no body forms in output"
+        (should (equal (ert-bdd-compile
+                        '(+describe test-name))
+                       nil))))
+
+    (+describe "one body form"
+      (+it "outputs those forms"
+        (should (equal (ert-bdd-compile
+                        '(+describe test-name x))
+                       'x))))
+
+    (+describe "many body forms"
+      (+it "outputs those forms"
+        (should (equal (ert-bdd-compile
+                        '(+describe test-name x y))
+                       '(progn x y)))))
+
+    (+describe "input contains no `+it' forms"
+      (let ((input '(let* ((x 1)
+                           (y 2))
+                      x
+                      y
+                      (defun foo ()
+                        (+ x y)))))
+        (+it "does not transform its input"
+          (should (equal (ert-bdd-compile input) input))))))
+
+
+  (+describe "input is an `+it'"
+
+    (+describe "no body forms"
+      (+it "generated test has no body"
+        (should (equal (ert-bdd-compile
+                        '(+it test-name))
+                       '(ert-deftest test-name ())))))
+
+    (+describe "one body form"
+      (+it "generated test has that form as its body"
+        (should (equal (ert-bdd-compile
+                        '(+it test-name x))
+                       '(ert-deftest test-name ()
+                          x)))))
+
+    (+describe "many body forms"
+      (+it "generated test has those body forms"
+        (should (equal (ert-bdd-compile
+                        '(+it test-name x y))
+                       '(ert-deftest test-name ()
+                          x
+                          y)))))
+
+    (+describe "test name is a symbol"
+      (+it "produces the expected test"
+        (should (equal
+                 (ert-bdd-compile
+                  '(+it test-name
+                     (should (equal 1 2))))
+                 '(ert-deftest test-name ()
+                    (should (equal 1 2)))))))
+
+    (+describe "test name is a string"
+      (+it "produces the expected test"
+        (should (equal
+                 (ert-bdd-compile
+                  '(+it "test name"
+                     (should (equal 1 2))))
+                 '(ert-deftest test-name ()
+                    (should (equal 1 2))))))))
+
+
+  (+describe "an +it is wrapped in another form"
+    (+it "is still macro-expanded"
+      (should (equal
+
+               (ert-bdd-compile
+                '(let ((x 1))
+                   (+it "test name"
+                     (should (= x 1)))))
+
+
+               '(let ((x 1))
+                  (ert-deftest test-name ()
+                    (should (= x 1)))))))))
+
+
+(provide 'ert-bdd)
+
+;;; ert-bdd.el ends here