Subject: bug#24940: [PATCH] Add should-call, should-not-call, and their tests

From: Gemini Lasswell <[email-masked]>
Date: Sun, 13 Nov 2016 14:22:08 -0800

Hello,

In the process of writing tests for kmacro.el, I wrote two macros,
should-call and should-not-call, that create context by temporarily
adding advice to named functions. They allow a test writer to express
expectations of how functions are used, to mock up responses of those
functions to the code under test, and to prevent functions from running
which might modify the global state of Emacs in an undesirable way
during a test.

I think that these macros would be useful additions to ERT. Here is a
patch containing versions of the macros which are integrated into ERT
and which provide better failure reporting than the ones that I included
with the kmacro-tests.el patch in bug#24939.

I also rewrote one test from files-tests.el as an example of usage and
included it with the patch. It shows how the macros can help make the
logic of a test clearer by removing the clutter of extra variables used
to keep track of the arguments passed in function calls made by the code
under test. For more examples, see the kmacro-tests.el patch in
bug#24939.

Let me know if you see ways to make this code better, or if there's any
part of adding functionality to Emacs that I've missed here.

>From 8c24022658738c3e32f94d1033caf7df36142a46 Mon Sep 17 00:00:00 2001
From: gazally <[email-masked]>
Date: Sun, 13 Nov 2016 10:50:23 -0800
Subject: [PATCH] Add should-call, should-not-call, and their tests

* lisp/emacs-lisp/ert.el (should-call, should-not-call): New macros.
* doc/misc/ert.texi
(How to Write Tests): Document should-call and should-not-call.
(Mocks and Stubs): Mention should-call, and delete old Emacs wiki
reference.
* test/lisp/emacs-lisp/ert-tests.el
(ert-test-verify-no-advice, ert-test-should-call-fails-test-on-no-call)
(ert-test-should-call-fails-test-when-call-count-incorrect)
(ert-test-should-call-collects-arg-list)
(ert-test-should-call-check-args-with-failure)
(ert-test-should-not-call-fails-test-when-function-called)
(ert-test-should-call-cleans-up-after-failure-in-user-advice):
Tests for should-call and should-not-call.
(ert-test-testfunc1, ert-test-testfunc2, ert-test-testfunc3)
(ert-test-verify-no-advice): Helper functions for should-call and
should-not-call tests.
* test/lisp/files-tests.el
(files-test--save-buffers-kill-emacs--confirm-kill-processes):
Use should-call and should-not-call instead of cl-letf.
---
 doc/misc/ert.texi                 |  81 +++++++++++++++++++--
 etc/NEWS                          |   5 ++
 lisp/emacs-lisp/ert.el            | 147 +++++++++++++++++++++++++++++++++++---
 test/lisp/emacs-lisp/ert-tests.el | 128 +++++++++++++++++++++++++++++++++
 test/lisp/files-tests.el          |  31 ++++----
 5 files changed, 358 insertions(+), 34 deletions(-)

diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index 144dfd9..f1ff265 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -73,6 +73,7 @@ Top
 How to Write Tests
 
 * The @code{should} Macro::          A powerful way to express assertions.
+* The @code{should-call} Macro::     Testing interactions with other code.
 * Expected Failures::           Tests for known bugs.
 * Tests and Their Environment:: Don't depend on customizations; no side effects.
 * Useful Techniques::           Some examples.
@@ -353,6 +354,7 @@ How to Write Tests
 
 @menu
 * The @code{should} Macro::          A powerful way to express assertions.
+* The @code{should-call} Macro::     Testing interactions with other code.
 * Expected Failures::           Tests for known bugs.
 * Tests and Their Environment:: Don't depend on customizations; no side effects.
 * Useful Techniques::           Some examples.
@@ -421,6 +423,76 @@ The @code{should} Macro
 @xref{Understanding Explanations}, for more details on what
 @code{should} reports.
 
+@node The @code{should-call} Macro
+@section The @code{should-call} Macro
+
+Sometimes when writing tests for code that is part of a complicated
+system, it is necessary to test that calls to an underlying interface
+are made correctly. Sometimes such checking can be done while the
+underlying code runs normally and sometimes it is better to prevent
+that code from running, for example if it makes changes to Emacs's
+global state.
+
+Emacs Lisp's advice mechanism is ideal for this sort of work, and the
+@code{should-call} macro can add and remove advice on named functions,
+while making sure that any added advice is cleaned up if a test fails.
+An example use of @code{should-call}:
+
+@lisp
+(ert-deftest correct-usage ()
+  (should-call ((useful-function :once
+                                 :before (lambda (arg)
+                                           (should (equal arg "test"))))
+                (expensive-function :times 2
+                                    :override (lambda (arg)
+                                                (should (integerp arg)))))
+    (function-to-test "test" 2)))
+@end lisp
+
+This test will pass if @code{function-to-test} calls
+@code{useful-function} once with @code{"test"}, and
+@code{expensive-function} twice with an integer argument each
+time. @code{useful-function} will be called but
+@code{expensive-function} will not be. The order in which the calls
+happen does not matter in this example.
+
+Like @code{let}, @code{should-call} takes a list of bindings and a
+body of code to execute. Each binding begins with a symbol already
+bound to a function, and is followed by a description of the check to
+make on the number of times the function is called, which can be
+@code{:once}, @code{:times} followed by a number, or
+@code{:check-args-with} followed by a function. The last part of each
+binding is optional, and provides advice to attach to the function
+during the execution of your test code. The advice is described by a
+keyword calling method and function exactly as for
+@code{advice-add}. Here is an example where advice is not given and
+@code{:check-args-with} is used:
+
+@lisp
+(ert-deftest process-data-total ()
+  (should-call ((process-data :check-args-with
+                              (lambda (arglist)
+                                (eql 500
+                                     (apply #'+
+                                            (mapcar #'car arglist))))))
+     (function-to-test (make-list 500 ?x))))
+@end lisp
+
+The function form following @code{:check-args-with} is passed a list
+of all the argument lists given to the advised function (in reverse
+order). The test will pass or fail depending on the return value of
+the argument check function. So the test above does not set any
+expectation of how many times @code{function-to-test} calls
+@code{process-data}, just that the sum of all the first arguments in
+all the calls is the expected value.
+
+In addition to @code{should-call}, ERT provides
+@code{should-not-call}, which when given either a single named
+function or a list of them, and a body of code to execute, will cause
+the test to fail if any are called.
+
+@xref{Advising Functions,,, elisp, GNU Emacs Lisp Reference Manual},
+for more information on ways in which advice may be added to a function.
 
 @node Expected Failures
 @section Expected Failures
@@ -813,10 +885,11 @@ Mocks and Stubs
 @url{http://en.wikipedia.org/wiki/Mock_object} for an explanation of
 the corresponding concepts in object-oriented languages.
 
-ERT does not have built-in support for mocks or stubs.  The package
-@code{el-mock} (see @url{http://www.emacswiki.org/emacs/el-mock.el})
-offers mocks for Emacs Lisp and can be used in conjunction with ERT.
-
+ERT does not have built-in support for mocks or stubs. A global
+function definition can be redefined for the duration of a test using
+@code{cl-letf}. Emacs Lisp's advice mechanism can be used to attach
+additional functionality to a function in a variety of ways, and ERT's
+@code{should-call} macro can attach temporary advice during a test.
 
 @node Fixtures and Test Suites
 @section Fixtures and Test Suites
diff --git a/etc/NEWS b/etc/NEWS
index fe76af5..4619cd2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -686,6 +686,11 @@ that does not exist.
 operating recursively and when some other process deletes the directory
 or its files before 'delete-directory' gets to them.
 
+** The new macro 'should-call' adds advice to one or more global
+functions for the duration of a test, and requires that the functions
+be called by the test. The new macro 'should-not-call' uses advice to
+do the opposite.
+
 ** Changes in Frame- and Window- Handling
 
 +++
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 0308c9c..09f882a 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -34,17 +34,21 @@
 ;; `ert-run-tests-batch-and-exit' for non-interactive use.
 ;;
 ;; The body of `ert-deftest' forms resembles a function body, but the
-;; additional operators `should', `should-not', `should-error' and
-;; `skip-unless' are available.  `should' is similar to cl's `assert',
-;; but signals a different error when its condition is violated that
-;; is caught and processed by ERT.  In addition, it analyzes its
-;; argument form and records information that helps debugging
-;; (`assert' tries to do something similar when its second argument
-;; SHOW-ARGS is true, but `should' is more sophisticated).  For
-;; information on `should-not' and `should-error', see their
-;; docstrings.  `skip-unless' skips the test immediately without
-;; processing further, this is useful for checking the test
-;; environment (like availability of features, external binaries, etc).
+;; additional operators `should', `should-not', `should-error',
+;; `should-call' and `should-not-call' `skip-unless' are available.
+
+;; `should' is similar to cl's `assert', but signals a different error
+;; when its condition is violated that is caught and processed by ERT.
+;; In addition, it analyzes its argument form and records information
+;; that helps debugging (`assert' tries to do something similar when
+;; its second argument SHOW-ARGS is true, but `should' is more
+;; sophisticated).  For information on `should-not', `should-error',
+;; `should-call' and `should-not-call', see their docstrings.
+;;
+;; `skip-unless' skips the test immediately without
+;; processing further.  This is useful for checking the test
+;; environment (like availability of features, external binaries,
+;; etc).
 ;;
 ;; See ERT's info manual as well as the docstrings for more details.
 ;; To compile the manual, run `makeinfo ert.texinfo' in the ERT
@@ -367,6 +371,127 @@ ert--expand-should
                         `(unless (not ,inner-form)
                            (ert-fail ,form-description-form)))))
 
+(defmacro should-call (defs &rest body)
+  "Verify that the function(s) in DEFS are called by BODY.
+
+DEFS should be a list containing elements of the form:
+ (FUNC ARGCHECK WHERE FUNCTION)
+
+where FUNC is a symbol, ARGCHECK is either :once, :times followed
+by a value, or :check-args-with followed by a function value.
+WHERE and FUNCTION are optional and have the same meaning as in
+`advice-add'.
+
+Temporarily add advice to each FUNC in DEFS, including advice
+which records the arguments passed to FUNC (by reference not
+copy, relevant for destructive functions), execute BODY, and then
+depending on the ARGCHECK forms, verify that FUNC was either
+called once, the specified number of times, or that the function
+following :check-args-with returns a non-nil value when passed a
+list of all the arguments passed to FUNC (which will be in
+reverse order).  If any of the checks fail, abort the current
+test as failed."
+  (declare (debug ((&rest [fboundp
+                           (&or ":once"
+                                [":times" form]
+                                [":check-args-with" function-form])
+                           &optional keywordp function-form])
+                   body))
+           (indent 1))
+  (ert--expand-should-or-should-not-call defs body))
+
+(defmacro should-not-call (func-or-funcs &rest body)
+  "Verify that FUNC-OR-FUNCS are not called by BODY.
+FUNC-OR-FUNCS can either be a single function or a list of them.
+Add advice to them that will cause the test to fail if any are
+called during the execution of BODY."
+  (declare (debug (&or [(&rest fboundp) body]
+                       [fboundp body]))
+           (indent 1))
+  (let* ((funcs (if (consp func-or-funcs)
+                    func-or-funcs
+                  (list func-or-funcs)))
+         (defs (mapcar (lambda (f) (list f :not)) funcs)))
+    (ert--expand-should-or-should-not-call defs body)))
+
+(defun ert--expand-should-or-should-not-call (defs body)
+  "Helper function for should-call and should-not-call.
+DEFS and BODY are the same as for should-call, except that one additional
+ARGCHECK keyword is allowed, :not, for use by should-not-call."
+  (if (null defs)
+      `(progn ,@body)
+    (let* ((def (car defs))
+           (func (car def))
+           (g-arglist (cl-gensym "args-list-"))
+           (g-argrec (cl-gensym "args-rec-"))
+           (g-advice (cl-gensym "should-call-advice-"))
+           (g-call-count (cl-gensym "call-count-"))
+           (argcheck-type (nth 1 def))
+           (check-val (unless (memq argcheck-type '(:once :not)) (nth 2 def)))
+           (form-description-form `(should-call ("..." ,def "...") ,@body))
+           (advice-given (> (length def) 3))
+           (advice-keyword (and advice-given (car (last def 2))))
+           (advice-function (and advice-given (car (last def)))))
+
+      (when (eq argcheck-type :once)
+        (setq argcheck-type :times)
+        (setq check-val 1))
+      (when (eq argcheck-type :not)
+        (setq form-description-form
+              `(should-not-call ("..." ,func "...") ,@body))
+        (setq advice-given t)
+        (setq advice-keyword :override)
+        (setq advice-function `(lambda (&rest _args)
+                                 (ert-fail (list
+                                           ',form-description-form
+                                           :fail-reason
+                                           (format "%s was called" ',func))))))
+      ;; Add two pieces of advice to the function: the one provided in
+      ;; the definitions list, and another to record the arguments.
+      `(let* (,g-arglist
+              (,g-argrec (lambda (&rest args)
+                           (push args ,g-arglist)))
+              ,@(when advice-given
+                  `((,g-advice ,advice-function)))) ; only evaluate this once
+         (advice-add ',func :before ,g-argrec '((depth . -100)))
+         (unwind-protect
+             (progn
+               ,@(when advice-given
+                   `((advice-add ',func ,advice-keyword ,g-advice
+                                 '((depth . -99)))))
+               (unwind-protect
+                   ,(ert--expand-should-or-should-not-call (cdr defs) body)
+                 ,@(when advice-given
+                     `((advice-remove ',func ,g-advice)))))
+           (advice-remove ',func ,g-argrec))
+         ;; Generate the after-execution argument list check.
+         ,(cond
+           ((eq argcheck-type :times)
+            `(let ((,g-call-count (length ,g-arglist)))
+               (unless (eql ,g-call-count ,check-val)
+                 (ert-fail (list
+                            ',form-description-form
+                            :fail-reason
+                            (format (cond
+                                     ((zerop ,check-val)
+                                      "%s was called")
+                                     ((zerop ,g-call-count)
+                                      "%s was not called")
+                                     (t "%s was called %s time%s"))
+                                    ',func ,g-call-count
+                                    (if (eql 1 ,g-call-count)
+                                        "" "s")))))))
+           ((eq argcheck-type :check-args-with)
+            `(unless (funcall ,check-val ,g-arglist)
+               (ert-fail (list
+                          ',form-description-form
+                          :condition
+                          (list 'apply ',check-val ,g-arglist)
+                          :fail-reason
+                          ":check-args-with null result")))))
+         (ert--signal-should-execution ',form-description-form)))))
+
+
 (defun ert--should-error-handle-error (form-description-fn
                                        condition type exclude-subtypes)
   "Helper function for `should-error'.
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index 5d36755..bec6962 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -294,6 +294,134 @@ ert-self-test-and-exit
                   "the error signaled was a subtype of the expected type")))))
     ))
 
+;; Some named functions for should-call testing
+
+(defvar ert-test-testfunc-counters [0 0 0])
+(defun ert-test-testfunc1 (arg)
+  (incf (aref ert-test-testfunc-counters 0)))
+
+(defun ert-test-testfunc2 (arg)
+  (incf (aref ert-test-testfunc-counters 1)))
+
+(defun ert-test-testfunc3 (arg)
+  (incf (aref ert-test-testfunc-counters 2)))
+
+(defun ert-test-verify-no-advice (sym)
+  "Verify that SYM has no advice attached to it."
+  (let (advice)
+    (advice-mapc (lambda (&rest args) (push args advice)) sym)
+    (should-not advice)))
+
+(ert-deftest ert-test-should-call-fails-test-on-no-call ()
+  "`should-call' fails test if function not called."
+  (let ((funcs '(ert-test-testfunc1 ert-test-testfunc2 ert-test-testfunc3))
+        (ert-test-testfunc-counters (make-vector 3 0)))
+    (dolist (omitted funcs)
+      (let* ((funcs-to-call (remq omitted funcs))
+             (test (make-ert-test :body (lambda ()
+                                          (should-call ((ert-test-testfunc1 :once)
+                                                        (ert-test-testfunc2 :once)
+                                                        (ert-test-testfunc3 :once))
+                                            (dolist (f funcs-to-call)
+                                              (funcall f nil))))))
+             (result (ert-run-test test)))
+        (should (ert-test-failed-p result))
+        (pcase (ert-test-result-with-condition-condition result)
+          (`(ert-test-failed (,_form :fail-reason ,msg))
+           (should (string= (format "%s was not called" omitted)
+                            msg)))
+          (_
+           (should-not (or result t))))))
+    ;; Make sure all advice was removed
+    (dolist (f funcs)
+      (ert-test-verify-no-advice f))
+    ;; Make sure test functions got called
+    (should (equal [2 2 2] ert-test-testfunc-counters))))
+
+(ert-deftest ert-test-should-call-fails-test-when-call-count-incorrect ()
+  "`should-call' fails test if function not called the correct number of times."
+  (let* ((ert-test-testfunc-counters (make-vector 3 0))
+         (test (make-ert-test :body (lambda ()
+                                      (should-call ((ert-test-testfunc1 :times 2)
+                                                    (ert-test-testfunc2 :times 2))
+                                        (ert-test-testfunc1 nil)
+                                        (ert-test-testfunc2 nil)
+                                        (ert-test-testfunc2 nil)))))
+         (result (ert-run-test test)))
+    (should (ert-test-failed-p result))
+    (pcase (ert-test-result-with-condition-condition result)
+      (`(ert-test-failed (,_form :fail-reason ,msg))
+       (should (string= "ert-test-testfunc1 was called 1 time" msg)))
+      (_ (should-not (or result t))))
+    (should (equal [1 2 0] ert-test-testfunc-counters)))
+  (ert-test-verify-no-advice 'ert-test-testfunc1))
+
+(ert-deftest ert-test-should-call-collects-arg-list ()
+  "`should-call' collects function arguments if :check-args-with is used."
+  (let ((ert-test-testfunc-counters (make-vector 3 0)))
+    (should-call ((ert-test-testfunc1 :check-args-with
+                                      (lambda (arglist)
+                                        (equal arglist '((4) (3) (2) (1) (0))))))
+      (dotimes (n 5)
+        (ert-test-testfunc1 n)))
+    (should (equal [5 0 0] ert-test-testfunc-counters)))
+  (ert-test-verify-no-advice 'ert-test-testfunc1))
+
+(ert-deftest ert-test-should-call-check-args-with-failure ()
+  "`should-call' causes test to fail if :check-args-with lambda returns nil."
+  (let* ((ert-test-testfunc-counters (make-vector 3 0))
+         (test (make-ert-test :body (lambda ()
+                                      (should-call ((ert-test-testfunc1
+                                                     :check-args-with
+                                                     'ignore))
+                                        (ert-test-testfunc1 42)))))
+         (result (ert-run-test test)))
+    (should (ert-test-failed-p result))
+    (should (equal (ert-test-result-with-condition-condition result)
+                   '(ert-test-failed ((should-call ("..." (ert-test-testfunc1
+                                                           :check-args-with
+                                                           'ignore)
+                                                    "...")
+                                        (ert-test-testfunc1 42))
+                                      :condition (apply (quote ignore) ((42)))
+                                      :fail-reason
+                                      ":check-args-with null result"))))
+    (should (equal [1 0 0] ert-test-testfunc-counters)))
+  (ert-test-verify-no-advice 'ert-test-testfunc1))
+
+(ert-deftest ert-test-should-not-call-fails-test-when-function-called ()
+  "`should-not-call' causes test to fail if listed function is called."
+  (let* ((ert-test-testfunc-counters (make-vector 3 0))
+         (test (make-ert-test :body (lambda ()
+                                      (should-not-call (ert-test-testfunc1
+                                                        ert-test-testfunc2)
+                                        (ert-test-testfunc1 nil)))))
+         (result (ert-run-test test)))
+    (should (ert-test-failed-p result))
+    (should (equal (ert-test-result-with-condition-condition result)
+                   '(ert-test-failed ((should-not-call ("..."
+                                                        ert-test-testfunc1
+                                                        "...")
+                                        (ert-test-testfunc1 nil))
+                                      :fail-reason
+                                      "ert-test-testfunc1 was called"))))
+    (should (equal [0 0 0] ert-test-testfunc-counters)))
+  (ert-test-verify-no-advice 'ert-test-testfunc1))
+
+(ert-deftest ert-test-should-call-cleans-up-after-failure-in-user-advice ()
+  "`should-call' removes advice after an error in supplied advice function."
+  (let ((ert-test-testfunc-counters (make-vector 3 0)))
+    (should-error
+     (should-call ((ert-test-testfunc1 :once :override #'ignore)
+                   (ert-test-testfunc2 :once :around (lambda (func arg)
+                                                       (signal 'arith-error nil))))
+       (ert-test-testfunc1 nil)
+       (ert-test-testfunc2 nil)))
+    (should (equal [0 0 0] ert-test-testfunc-counters)))
+  (ert-test-verify-no-advice 'ert-test-testfunc1)
+  (ert-test-verify-no-advice 'ert-test-testfunc2))
+
+
 (ert-deftest ert-test-skip-unless ()
   ;; Don't skip.
   (let ((test (make-ert-test :body (lambda () (skip-unless t)))))
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 80d5e5b..753ea78 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -200,25 +200,18 @@ files-test-bug-18141-file
 (ert-deftest files-test--save-buffers-kill-emacs--confirm-kill-processes ()
   "Test that `save-buffers-kill-emacs' honors
 `confirm-kill-processes'."
-  (cl-letf* ((yes-or-no-p-prompts nil)
-             ((symbol-function #'yes-or-no-p)
-              (lambda (prompt)
-                (push prompt yes-or-no-p-prompts)
-                nil))
-             (kill-emacs-args nil)
-             ((symbol-function #'kill-emacs)
-              (lambda (&optional arg) (push arg kill-emacs-args)))
-             (process
-              (make-process
-               :name "sleep"
-               :command (list
-                         (expand-file-name invocation-name invocation-directory)
-                         "-batch" "-Q" "-eval" "(sleep-for 1000)")))
-             (confirm-kill-processes nil))
-    (save-buffers-kill-emacs)
-    (kill-process process)
-    (should-not yes-or-no-p-prompts)
-    (should (equal kill-emacs-args '(nil)))))
+  (should-call ((kill-emacs :once :override (lambda (&optional arg)
+                                              (should-not arg))))
+    (should-not-call yes-or-no-p
+      (let ((process
+             (make-process
+              :name "sleep"
+              :command (list
+                        (expand-file-name invocation-name invocation-directory)
+                        "-batch" "-Q" "-eval" "(sleep-for 1000)")))
+            (confirm-kill-processes nil))
+        (save-buffers-kill-emacs)
+        (kill-process process)))))
 
 (provide 'files-tests)
 ;;; files-tests.el ends here
-- 
2.10.1