[nongnu] elpa/buttercup 5db449f 025/340: Spies

[ELPA Syncer]

branch: elpa/buttercup
commit 5db449f158c5ba46da6b66bdb1ac4f71a06b499f
Author: Jorgen Schaefer <contact@jorgenschaefer.de>
Commit: Jorgen Schaefer <contact@jorgenschaefer.de>

    Spies
---
 README.md         | 37 ++++++++++++++++++++++++++
 buttercup-test.el | 53 +++++++++++++++++++++++++++++++++++++
 buttercup.el      | 78 +++++++++++++++++++++++++++++++++++++++++++++++--------
 3 files changed, 157 insertions(+), 11 deletions(-)

diff --git a/README.md b/README.md
index 32c36d5..20062db 100644
--- a/README.md
+++ b/README.md
@@ -307,6 +307,43 @@ pending in results.
   (it "can be declared with `it' but without a body"))
 ```
 
+## Spies
+
+Buttercup has test double functions called spies. While other
+frameworks call these mocks and similar, we call them spies, because
+their main job is to spy in on function calls. Also, Jasmine calls
+them spies, and so do we. A spy can stub any function and tracks calls
+to it and all arguments. A spy only exists in the `describe` or `it`
+block it is defined in, and will be removed after each spec. There are
+special matchers for interacting with spies. The
+`:to-have-been-called` matcher will return true if the spy was called
+at all. The `:to-have-been-called-with` matcher will return true if
+the argument list matches any of the recorded calls to the spy.
+
+```Lisp
+(describe "A spy"
+  (let (foo bar)
+    (before-each
+     (setf (symbol-function 'foo)
+           (lambda (value)
+             (setq bar value)))
+
+     (spy-on 'foo)
+
+     (foo 123)
+     (foo 456 "another param"))
+
+    (it "tracks that the spy was called"
+      (expect 'foo :to-have-been-called))
+
+    (it "tracks all arguments of its calls"
+      (expect 'foo :to-have-been-called-with 123)
+      (expect 'foo :to-have-been-called-with 456 "another param"))
+
+    (it "stops all execution on a function"
+      (expect bar :to-be nil))))
+```
+
 ## Test Runners
 
 Evaluating `describe` forms just stores the suites. You need to use a
diff --git a/buttercup-test.el b/buttercup-test.el
index 1f33e54..cb071c4 100644
--- a/buttercup-test.el
+++ b/buttercup-test.el
@@ -324,3 +324,56 @@
                "bla bla"
                (lambda () (error "should not happen"))))
             :not :to-throw)))
+
+;;;;;;;;;
+;;; Spies
+
+(defun test-function (a b)
+  (+ a b))
+
+(describe "The `spy-on' function"
+  (it "replaces a symbol's function slot"
+    (spy-on 'test-function)
+    (expect (test-function 1 2) :to-be nil))
+
+  (it "restores the old value after a spec run"
+    (expect (test-function 1 2) :to-equal 3)))
+
+(describe "The :to-have-been-called matcher"
+  (before-each
+    (spy-on 'test-function))
+
+  (it "returns false if the spy was not called"
+    (expect (buttercup--apply-matcher :to-have-been-called '(test-function))
+            :to-be
+            nil))
+
+  (it "returns true if the spy was called at all"
+    (test-function 1 2 3)
+    (expect (buttercup--apply-matcher :to-have-been-called '(test-function))
+            :to-be
+            t)))
+
+(describe "The :to-have-been-called-with matcher"
+  (before-each
+    (spy-on 'test-function))
+
+  (it "returns false if the spy was not called at all"
+    (expect (buttercup--apply-matcher
+             :to-have-been-called-with '(test-function 1 2 3))
+            :to-be
+            nil))
+
+  (it "returns false if the spy was called with different arguments"
+    (test-function 3 2 1)
+    (expect (buttercup--apply-matcher
+             :to-have-been-called-with '(test-function 1 2 3))
+            :to-be
+            nil))
+
+  (it "returns true if the spy was called with those arguments"
+    (test-function 1 2 3)
+    (expect (buttercup--apply-matcher
+             :to-have-been-called-with '(test-function 1 2 3))
+            :to-be
+            t)))
diff --git a/buttercup.el b/buttercup.el
index bb400ad..87c6d7f 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -362,6 +362,53 @@ A disabled spec is not run."
 A disabled spec is not run."
   nil)
 
+;;;;;;;;;
+;;; Spies
+
+(defvar buttercup--spy-calls (make-hash-table :test 'eq
+                                              :weakness 'key))
+
+(defun spy-on (symbol)
+  (letrec ((old-value (symbol-function symbol))
+           (new-value (lambda (&rest args)
+                        (buttercup--spy-add-call new-value args)
+                        nil)))
+    (fset symbol new-value)
+    (buttercup--add-cleanup (lambda () (fset symbol old-value)))))
+
+(defun buttercup--add-cleanup (function)
+  (if buttercup--current-suite
+      (buttercup-after-each function)
+    (setq buttercup--cleanup-forms
+          (append buttercup--cleanup-forms
+                  (list function)))))
+
+(defun buttercup--spy-add-call (spy args)
+  (puthash spy
+           (append (buttercup--spy-calls spy)
+                   (list args))
+           buttercup--spy-calls))
+
+(defun buttercup--spy-calls (spy)
+  (gethash spy buttercup--spy-calls))
+
+(buttercup-define-matcher :to-have-been-called (spy)
+  (let ((spy (if (symbolp spy)
+                 (symbol-function spy)
+               spy)))
+    (if (buttercup--spy-calls spy)
+        t
+      nil)))
+
+(buttercup-define-matcher :to-have-been-called-with (spy &rest args)
+  (let* ((spy (if (symbolp spy)
+                  (symbol-function spy)
+                spy))
+         (calls (buttercup--spy-calls spy)))
+    (if (member args calls)
+        t
+      nil)))
+
 ;; (let* ((buttercup--descriptions (cons description
 ;;                                       buttercup--descriptions))
 ;;        (debugger (lambda (&rest args)
@@ -417,7 +464,8 @@ Do not change the global value.")
          (buttercup--before-each (append buttercup--before-each
                                          (buttercup-suite-before-each suite)))
          (buttercup--after-each (append (buttercup-suite-after-each suite)
-                                        buttercup--after-each)))
+                                        buttercup--after-each))
+         (debug-on-error t))
     (message "%s%s" indent (buttercup-suite-description suite))
     (dolist (f (buttercup-suite-before-all suite))
       (funcall f))
@@ -426,18 +474,27 @@ Do not change the global value.")
        ((buttercup-suite-p sub)
         (buttercup-run-suite sub (1+ level)))
        ((buttercup-spec-p sub)
-        (message "%s%s"
-                 (make-string (* 2 (1+ level)) ?\s)
-                 (buttercup-spec-description sub))
-        (dolist (f buttercup--before-each)
-          (funcall f))
-        (funcall (buttercup-spec-function sub))
-        (dolist (f buttercup--after-each)
-          (funcall f)))))
+        (buttercup-run-spec sub (1+ level)))))
     (dolist (f (buttercup-suite-after-all suite))
       (funcall f))
     (message "")))
 
+(defvar buttercup--cleanup-forms nil
+  "")
+
+(defun buttercup-run-spec (spec level)
+  (let ((buttercup--cleanup-forms nil))
+    (message "%s%s"
+             (make-string (* 2 level) ?\s)
+             (buttercup-spec-description spec))
+    (dolist (f buttercup--before-each)
+      (funcall f))
+    (funcall (buttercup-spec-function spec))
+    (dolist (f buttercup--cleanup-forms)
+      (funcall f))
+    (dolist (f buttercup--after-each)
+      (funcall f))))
+
 (defun buttercup-run-at-point ()
   (let ((buttercup-suites nil)
         (lexical-binding t))
@@ -455,8 +512,7 @@ Do not change the global value.")
             (with-current-buffer lisp-buffer
               (insert code))))))
     (with-current-buffer lisp-buffer
-      (setq lexical-binding t
-            debug-on-error t)
+      (setq lexical-binding t)
       (eval-region (point-min)
                    (point-max)))
     (buttercup-run)))