[nongnu] elpa/buttercup c720cef 233/340: Merge pull request #146 from DarwinAwardWinner/spy-record-errors

[ELPA Syncer]

branch: elpa/buttercup
commit c720cefc2511a74a62fbf1e2b0d53c266a2da1ad
Merge: 8a28489 6cf8041
Author: Ola Nilsson <ola.nilsson@gmail.com>
Commit: GitHub <noreply@github.com>

    Merge pull request #146 from DarwinAwardWinner/spy-record-errors
    
    Make spies record calls that throw errors
---
 buttercup.el            | 73 ++++++++++++++++++++++++++++++------------
 docs/writing-tests.md   | 84 +++++++++++++++++++++++++++++++++++++++++++------
 tests/test-buttercup.el | 65 +++++++++++++++++++++++++++++++++++---
 3 files changed, 187 insertions(+), 35 deletions(-)

diff --git a/buttercup.el b/buttercup.el
index 397e2f3..ffe5b42 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -647,7 +647,7 @@ See also `buttercup-define-matcher'."
   (setq spy (funcall spy)
         number (funcall number))
   (cl-assert (symbolp spy))
-  (let* ((call-count (length (spy-calls-all spy))))
+  (let* ((call-count (spy-calls-count spy)))
     (cond
      ((= number call-count)
       t)
@@ -1023,9 +1023,14 @@ DESCRIPTION has the same meaning as in `xit'. FUNCTION 
is ignored."
   "A mapping of currently-defined spies to their contexts.")
 
 (cl-defstruct spy-context
-  args
-  return-value
-  current-buffer)
+  args current-buffer)
+;; The struct and slot names are kind of a cheat so that the accessor
+;; function names remain unchanged: `spy-context-return-value' and
+;; `spy-context-thrown-signal'.
+(cl-defstruct (spy-context-return (:include spy-context))
+  value)
+(cl-defstruct (spy-context-thrown (:include spy-context))
+  signal)
 
 (defun spy-on (symbol &optional keyword arg)
   "Create a spy (mock) for the function SYMBOL.
@@ -1094,32 +1099,50 @@ responsibility to ensure ARG is a command."
                 nil))
             (_
              (error "Invalid `spy-on' keyword: `%S'" keyword)))))
-    (buttercup--spy-on-and-call-fake symbol replacement)))
+    (buttercup--spy-on-and-call-replacement symbol replacement)))
 
-(defun buttercup--spy-on-and-call-fake (spy fake-function)
-  "Replace the function in symbol SPY with a spy calling FAKE-FUNCTION."
+(defun buttercup--spy-on-and-call-replacement (spy fun)
+  "Replace the function in symbol SPY with a spy calling FUN."
   (let ((orig-function (symbol-function spy)))
-    (fset spy (buttercup--make-spy fake-function))
+    (fset spy (buttercup--make-spy fun))
     (buttercup--add-cleanup (lambda ()
                               (fset spy orig-function)))))
 
-(defun buttercup--make-spy (fake-function)
-  "Create a new spy function wrapping FAKE-FUNCTION and tracking calls to 
itself."
+(defun buttercup--make-spy (fun)
+  "Create a new spy function wrapping FUN and tracking calls to itself."
   (let (this-spy-function)
-    (setq this-spy-function
-          (lambda (&rest args)
-            (let ((return-value (apply fake-function args)))
+    (setq
+     this-spy-function
+     (lambda (&rest args)
+       (let ((returned nil)
+             (return-value nil))
+         (condition-case err
+             (progn
+               (setq return-value (apply fun args)
+                     returned t)
+               (buttercup--spy-calls-add
+                this-spy-function
+                (make-spy-context-return :args args
+                                         :value return-value
+                                         :current-buffer (current-buffer)))
+               return-value)
+           (error
+            ;; If returned is non-nil, then the error we caught
+            ;; didn't come from FUN, so we shouldn't record it.
+            (unless returned
               (buttercup--spy-calls-add
                this-spy-function
-               (make-spy-context :args args
-                                 :return-value return-value
-                                 :current-buffer (current-buffer)))
-              return-value)))
-    ;; Add the interactive form from `fake-function', if any
-    (when (interactive-form fake-function)
+               (make-spy-context-thrown :args args
+                                        :signal err
+                                        :current-buffer (current-buffer))))
+            ;; Regardless, we only caught this error in order to
+            ;; record it, so we need to re-throw it.
+            (signal (car err) (cdr err)))))))
+    ;; Add the interactive form from `fun', if any
+    (when (interactive-form fun)
       (setq this-spy-function
             `(lambda (&rest args)
-               ,(interactive-form fake-function)
+               ,(interactive-form fun)
                (apply ',this-spy-function args))))
     this-spy-function))
 
@@ -1172,6 +1195,16 @@ responsibility to ensure ARG is a command."
   "Return the number of times SPY has been called so far."
   (length (spy-calls-all spy)))
 
+(defun spy-calls-count-returned (spy)
+  "Return the number of times SPY has been called successfully so far."
+  (length (cl-remove-if-not 'spy-context-return-p
+                            (spy-calls-all spy))))
+
+(defun spy-calls-count-errors (spy)
+  "Return the number of times SPY has been called and thrown errors so far."
+  (length (cl-remove-if-not 'spy-context-thrown-p
+                            (spy-calls-all spy))))
+
 (defun spy-calls-args-for (spy index)
   "Return the context of the INDEXth call to SPY."
   (let ((context (elt (spy-calls-all spy)
diff --git a/docs/writing-tests.md b/docs/writing-tests.md
index cb72b28..94d9129 100644
--- a/docs/writing-tests.md
+++ b/docs/writing-tests.md
@@ -524,7 +524,8 @@ will `signal` the specified value as an error.
 ### Other tracking properties
 
 Every call to a spy is tracked and exposed using the `spy-calls`
-accessor.
+accessor. This tracks both successful calls and calls that throw
+errors.
 
 `spy-calls-any` returns `nil` if the spy has not been called at all,
 and then `t` once at least one call happens. `spy-calls-count` returns
@@ -536,6 +537,13 @@ current buffer and arguments passed to all calls.
 the most recent call. `spy-calls-first` returns the current buffer and
 arguments for the first call.
 
+Each spy context is a struct with 3 slots. A successful function call
+is represented by a `spy-context-return` struct with slots `args`,
+`current-buffer`, and `value`. A function call the signalled an error
+is represented by a `spy-context-thrown` struct with slots `args`,
+`current-buffer`, and `signal`. See the examples below for accessing
+these slots.
+
 Finally, `spy-calls-reset` clears all tracking for a spy.
 
 ```Emacs-Lisp
@@ -595,9 +603,9 @@ Finally, `spy-calls-reset` clears all tracking for a spy.
 
     (expect (spy-calls-all 'set-foo)
             :to-equal
-            `(,(make-spy-context :current-buffer (current-buffer)
-                                 :args '(123)
-                                 :return-value nil))))
+            `(,(make-spy-context-return :current-buffer (current-buffer)
+                                        :args '(123)
+                                        :value nil))))
 
   (it "has a shortcut to the most recent call"
     (set-foo 123)
@@ -605,9 +613,9 @@ Finally, `spy-calls-reset` clears all tracking for a spy.
 
     (expect (spy-calls-most-recent 'set-foo)
             :to-equal
-            (make-spy-context :current-buffer (current-buffer)
-                              :args '(456 "baz")
-                              :return-value nil)))
+            (make-spy-context-return :current-buffer (current-buffer)
+                                     :args '(456 "baz")
+                                     :value nil)))
 
   (it "has a shortcut to the first call"
     (set-foo 123)
@@ -615,9 +623,65 @@ Finally, `spy-calls-reset` clears all tracking for a spy.
 
     (expect (spy-calls-first 'set-foo)
             :to-equal
-            (make-spy-context :current-buffer (current-buffer)
-                              :args '(123)
-                              :return-value nil)))
+            (make-spy-context-return :current-buffer (current-buffer)
+                                     :args '(123)
+                                     :value nil)))
+
+  (it "tracks the return values and error signals of each call"
+    ;; Set up `set-foo' so that it can either return a value or throw
+    ;; an error
+    (spy-on 'set-foo :and-call-fake
+            (lambda (val &rest ignored)
+              (if (>= val 0)
+                  val
+                (error "Value must not be negative"))))
+    (expect (set-foo 1) :to-be 1)
+    (expect (set-foo -1) :to-throw 'error)
+    (expect (spy-context-return-p (spy-calls-first 'set-foo)))
+    (expect
+     (spy-context-return-value (spy-calls-first 'set-foo))
+     :to-be 1)
+    ;; Trying to get the thrown signal from a call that didn't throw a
+    ;; signal is an error
+    (expect
+     (spy-context-thrown-signal
+      (spy-calls-first 'set-foo))
+     :to-throw)
+
+    (expect (spy-context-thrown-p (spy-calls-most-recent 'set-foo)))
+    (expect
+     (spy-context-thrown-signal
+      (spy-calls-most-recent 'set-foo))
+     :to-equal '(error "Value must not be negative"))
+    ;; Trying to get the return value from a call that threw a signal
+    ;; raises an error
+    (expect
+     (spy-context-return-value
+      (spy-calls-most-recent 'set-foo))
+     :to-throw))
+
+  (it "counts the number of successful and failed calls"
+    ;; Set up `set-foo' so that it can either return a value or throw
+    ;; an error
+    (spy-on 'set-foo :and-call-fake
+            (lambda (val &rest ignored)
+              (if (>= val 0)
+                  val
+                (error "Value must not be negative"))))
+    (expect (set-foo 1) :to-be 1)
+    (expect (set-foo 2) :to-be 2)
+    (expect (set-foo 3) :to-be 3)
+    (expect (set-foo -1) :to-throw 'error)
+    (expect (set-foo -2) :to-throw 'error)
+    (expect (set-foo -3) :to-throw 'error)
+    (expect (set-foo -4) :to-throw 'error)
+
+    (expect (spy-calls-count 'set-foo)
+            :to-be 7)
+    (expect (spy-calls-count-returned 'set-foo)
+            :to-be 3)
+    (expect (spy-calls-count-errors 'set-foo)
+            :to-be 4))
 
   (it "can be reset"
     (set-foo 123)
diff --git a/tests/test-buttercup.el b/tests/test-buttercup.el
index e99a964..6368202 100644
--- a/tests/test-buttercup.el
+++ b/tests/test-buttercup.el
@@ -613,7 +613,9 @@
 ;;; Spies
 
 (describe "The Spy "
-  (let (saved-test-function saved-test-command)
+  (let (saved-test-function
+        saved-test-command
+        saved-test-function-throws-on-negative)
     ;; We use `before-all' here because some tests need to access the
     ;; same function as previous tests in order to work, so overriding
     ;; the function before each test would invalidate those tests.
@@ -621,19 +623,28 @@
       (setq saved-test-function (and (fboundp 'test-function)
                                      (symbol-function 'test-function))
             saved-test-command (and (fboundp 'test-command)
-                                    (symbol-function 'test-command)))
+                                    (symbol-function 'test-command))
+            saved-test-function-throws-on-negative
+            (and (fboundp 'test-function-throws-on-negative)
+                 (symbol-function 'test-function-throws-on-negative)))
       (fset 'test-function (lambda (a b)
                              (+ a b)))
       (fset 'test-command (lambda ()
                             (interactive)
-                            t)))
+                            t))
+      (fset 'test-function-throws-on-negative
+            (lambda (x) (if (>= x 0) x (error "x is less than zero")))))
     (after-all
       (if saved-test-function
           (fset 'test-function saved-test-function)
         (fmakunbound 'test-function))
       (if saved-test-command
           (fset 'test-command saved-test-command)
-        (fmakunbound 'test-command)))
+        (fmakunbound 'test-command))
+      (if saved-test-function-throws-on-negative
+          (fset 'test-function-throws-on-negative
+                saved-test-function-throws-on-negative)
+        (fmakunbound 'test-function-throws-on-negative)))
 
     (describe "`spy-on' function"
       (it "replaces a symbol's function slot"
@@ -881,7 +892,51 @@
       (it "throws an error when called"
         (expect (test-function 1 2)
                 :to-throw
-                'error "Stubbed error")))))
+                'error "Stubbed error")))
+
+    (describe "error-recording functionality"
+      (before-each
+        (spy-on 'test-function-throws-on-negative :and-call-through))
+
+      (it "records the function as called even if it throws an error"
+        (expect (test-function-throws-on-negative -5) :to-throw)
+        (expect (buttercup--apply-matcher
+                 :to-have-been-called
+                 (list (lambda () 'test-function-throws-on-negative)))
+                :to-be
+                t))
+
+      (it "counts both successful calls and calls that threw errors"
+        (test-function-throws-on-negative 5)
+        (expect (test-function-throws-on-negative -5) :to-throw)
+        (expect (buttercup--apply-matcher
+                 :to-have-been-called-times
+                 (make-list-of-closures '(test-function-throws-on-negative 2)))
+                :to-equal t))
+
+      (it "records args to the function whether it throw an error or not"
+        (test-function-throws-on-negative 5)
+        (expect (test-function-throws-on-negative -5) :to-throw)
+        (expect (buttercup--apply-matcher
+                 :to-have-been-called-with
+                 (make-list-of-closures '(test-function-throws-on-negative 5)))
+                :to-be
+                t)
+        (expect (buttercup--apply-matcher
+                 :to-have-been-called-with
+                 (make-list-of-closures '(test-function-throws-on-negative 
-5)))
+                :to-be
+                t))
+
+      (it "records the signal thrown by a call to the function"
+        (test-function-throws-on-negative 5)
+        (expect (test-function-throws-on-negative -5) :to-throw 'error)
+        (expect (spy-context-thrown-signal
+                 (spy-calls-first 'test-function-throws-on-negative))
+                :to-throw)
+        (expect (spy-context-thrown-signal
+                 (spy-calls-most-recent 'test-function-throws-on-negative))
+                :to-equal '(error "x is less than zero"))))))
 
 ;;;;;;;;;;;;;
 ;;; Reporters