[nongnu] elpa/buttercup 6ad9565 135/340: Fix several edge cases in "spy-on"

[ELPA Syncer]

branch: elpa/buttercup
commit 6ad9565cd7adc195f81bdbbc1115a6bd96802a72
Author: Ryan C. Thompson <rct@thompsonclan.org>
Commit: Jorgen Schäfer <Jorgen.Schaefer@gmail.com>

    Fix several edge cases in "spy-on"
    
    The "spy-on" function now works on commands and autoloaded functions,
    and checks for the right number of arguments for each modifier.
    
    For commands, it preserves the interactive form of the original
    command, unless the given replacement overrides it (in which case a
    warning is issued). This means that the spy can be executed as a
    command in the same way as the original.
    
    For autoloads, "spy-on" simply forces the load to happen so that the
    function becomes an ordinary function instead of an autoloaded one.
    
    Finally, all modifiers now check whether the correct number of args
    was provided instead of silently ignoring extra ones. In addition, the
    argument for ":and-throw-error" now defaults to "error" if a more
    specific error type is not specified.
    
    Tests are added for all three features.
    
    This should fix #56 and #103.
    
    Add autoload test
---
 buttercup.el            | 106 +++++++++++++++++++++++++++++++-----------------
 tests/test-buttercup.el |  52 +++++++++++++++++++++++-
 2 files changed, 119 insertions(+), 39 deletions(-)

diff --git a/buttercup.el b/buttercup.el
index bf33e83..94efd2c 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -550,28 +550,54 @@ KEYWORD can have one of the following values:
       the original function.
 
   nil -- Track calls, but simply return nil instead of calling
-      the original function."
-  (cond
-   ((eq keyword :and-call-through)
-    (let ((orig (symbol-function symbol)))
-      (buttercup--spy-on-and-call-fake symbol
-                                       (lambda (&rest args)
-                                         (apply orig args)))))
-   ((eq keyword :and-return-value)
-    (buttercup--spy-on-and-call-fake symbol
-                                     (lambda (&rest args)
-                                       arg)))
-   ((eq keyword :and-call-fake)
-    (buttercup--spy-on-and-call-fake symbol
-                                     arg))
-   ((eq keyword :and-throw-error)
-    (buttercup--spy-on-and-call-fake symbol
-                                     (lambda (&rest args)
-                                       (signal arg "Stubbed error"))))
-   (t
-    (buttercup--spy-on-and-call-fake symbol
-                                     (lambda (&rest args)
-                                       nil)))))
+      the original function.
+
+If the original function was a command, the generated spy will
+also be a command with the same interactive form, unless
+`:and-call-fake' is used, in which case it is the caller's
+responsibility to ensure ARG is a command."
+  ;; We need to load an autoloaded function before spying on it
+  (when (autoloadp (symbol-function symbol))
+    (autoload-do-load (symbol-function symbol) symbol))
+  (cl-assert (not (autoloadp (symbol-function symbol))))
+  (let* ((orig (symbol-function symbol))
+         (orig-intform (interactive-form orig))
+         (replacement
+          (pcase
+              keyword
+            (:and-call-through
+             (when arg
+               (error "`spy-on' with `:and-call-through' does not take an 
ARG"))
+             `(lambda (&rest args)
+                ,orig-intform
+                (apply ',orig args)))
+            (:and-return-value
+             `(lambda (&rest args)
+                ,orig-intform
+                ,arg))
+            (:and-call-fake
+             (let ((replacement-intform (interactive-form arg)))
+               (when (and replacement-intform
+                          (not (equal orig-intform replacement-intform)))
+                 (display-warning 'buttercup
+                                  "While spying on `%S': replacement does not 
have the same interactive form"))
+               `(lambda (&rest args)
+                  ,(or replacement-intform orig-intform)
+                  (apply (function ,arg) args))))
+            (:and-throw-error
+             `(lambda (&rest args)
+                ,orig-intform
+                (signal ',(or arg 'error) "Stubbed error")))
+            ;; No keyword: just spy
+            (`nil
+             (when arg
+               (error "`spy-on' with no KEYWORD does not take an ARG."))
+             `(lambda (&rest args)
+                ,orig-intform
+                nil))
+            (_
+             (error "Invalid `spy-on' keyword: `%S'" keyword)))))
+    (buttercup--spy-on-and-call-fake symbol replacement)))
 
 (defun buttercup--spy-on-and-call-fake (spy fake-function)
   "Replace the function in symbol SPY with a spy that calls FAKE-FUNCTION."
@@ -592,6 +618,12 @@ KEYWORD can have one of the following values:
                                  :return-value return-value
                                  :current-buffer (current-buffer)))
               return-value)))
+    ;; Add the interactive form from `fake-function', if any
+    (when (interactive-form fake-function)
+      (setq this-spy-function
+            `(lambda (&rest args)
+               ,(interactive-form fake-function)
+               (apply ',this-spy-function args))))
     this-spy-function))
 
 (defvar buttercup--cleanup-functions nil)
@@ -996,22 +1028,22 @@ Calls either `buttercup-reporter-batch' or
          (buttercup--print (buttercup-colorize "\r%s%s\n" 'green)
                            (make-string (* 2 level) ?\s)
                            (buttercup-spec-description arg)))
-      ((eq (buttercup-spec-status arg) 'failed)
-       (buttercup--print (buttercup-colorize "\r%s%s  FAILED\n" 'red)
-                         (make-string (* 2 level) ?\s)
-                         (buttercup-spec-description arg))
-       (setq buttercup-reporter-batch--failures
-             (append buttercup-reporter-batch--failures
-                     (list arg))))
-      ((eq (buttercup-spec-status arg) 'pending)
-       (if (equal (buttercup-spec-failure-description arg) "SKIPPED")
-           (buttercup--print "  %s\n" (buttercup-spec-failure-description arg))
-         (buttercup--print (buttercup-colorize "\r%s%s  %s\n" 'yellow)
+        ((eq (buttercup-spec-status arg) 'failed)
+         (buttercup--print (buttercup-colorize "\r%s%s  FAILED\n" 'red)
                            (make-string (* 2 level) ?\s)
-                           (buttercup-spec-description arg)
-                           (buttercup-spec-failure-description arg))))
-      (_
-       (error "Unknown spec status %s" (buttercup-spec-status arg))))))
+                           (buttercup-spec-description arg))
+         (setq buttercup-reporter-batch--failures
+               (append buttercup-reporter-batch--failures
+                       (list arg))))
+        ((eq (buttercup-spec-status arg) 'pending)
+         (if (equal (buttercup-spec-failure-description arg) "SKIPPED")
+             (buttercup--print "  %s\n" (buttercup-spec-failure-description 
arg))
+           (buttercup--print (buttercup-colorize "\r%s%s  %s\n" 'yellow)
+                             (make-string (* 2 level) ?\s)
+                             (buttercup-spec-description arg)
+                             (buttercup-spec-failure-description arg))))
+        (_
+         (error "Unknown spec status %s" (buttercup-spec-status arg))))))
 
     (`buttercup-done
      (dolist (failed buttercup-reporter-batch--failures)
diff --git a/tests/test-buttercup.el b/tests/test-buttercup.el
index 629f043..805ea8b 100644
--- a/tests/test-buttercup.el
+++ b/tests/test-buttercup.el
@@ -18,6 +18,7 @@
 ;;; Code:
 
 (require 'buttercup)
+(require 'autoload)
 (require 'ert)
 
 ;;;;;;;;;;
@@ -510,7 +511,10 @@
     ;; the function before each test would invalidate those tests.
     (before-all
       (fset 'test-function (lambda (a b)
-                             (+ a b))))
+                             (+ a b)))
+      (fset 'test-command (lambda ()
+                            (interactive)
+                            t)))
 
     (describe "`spy-on' function"
       (it "replaces a symbol's function slot"
@@ -518,7 +522,51 @@
         (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)))
+        (expect (test-function 1 2) :to-equal 3))
+
+      (it "allows a spied-on command to be executed as a command"
+        (spy-on 'test-command)
+        (expect (commandp 'test-command))
+        (expect (lambda () (command-execute 'test-command))
+                :not :to-throw)
+        (expect 'test-command :to-have-been-called))
+
+      (it "can spy on autoloaded functions"
+        (let* ((function-file (make-temp-file "test-file-" nil ".el"))
+               (function-name 'test-autoloaded-function)
+               (defun-form `(defun ,function-name ()
+                              "An autoloaded function"
+                              :loaded-successfully))
+               (autoload-form (make-autoload defun-form function-file)))
+          (unwind-protect
+              (progn
+                ;; Create the real function in a file
+                (with-temp-file function-file
+                  (insert ";; -*-lexical-binding:t-*-\n"
+                          (pp-to-string defun-form)))
+                ;; Define the autoload for the function
+                (fmakunbound function-name)
+                (eval autoload-form)
+                (expect (autoloadp (symbol-function function-name)))
+                (spy-on function-name :and-call-through)
+                (expect (not (autoloadp (symbol-function function-name))))
+                (expect (funcall function-name)
+                        :to-be :loaded-successfully))
+            (delete-file function-file nil))))
+
+      (it "only accepts ARG for keywords that use it"
+        (expect
+         (lambda () (spy-on 'test-function :and-call-through :arg-not-allowed))
+         :to-throw)
+        (expect
+         (lambda () (spy-on 'test-function nil :arg-not-allowed))
+         :to-throw)
+        (expect
+         (lambda () (spy-on 'test-function :and-throw-error))
+         :not :to-throw)
+        (expect
+         (lambda () (test-function 1 2))
+         :to-throw 'error)))
 
     (describe ":to-have-been-called matcher"
       (before-each