>From 8c24022658738c3e32f94d1033caf7df36142a46 Mon Sep 17 00:00:00 2001 From: gazally 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