; Merge from origin/emacs-25

[gnu-emacs] / lisp / emacs-lisp / ert-x.el

diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 531e83c1e6ac0d3ae714d787c489c8ca284e728a..eb10c845d3fa4643c500f0f29fd5a3ee2ac7be11 100644 (file)
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -1,6 +1,6 @@
 ;;; ert-x.el --- Staging area for experimental extensions to ERT  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2008, 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2010-2016 Free Software Foundation, Inc.
 
 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
 ;;         Christian Ohler <ohler@gnu.org>
@@ -137,7 +137,7 @@ the name of the test and the result of NAME-FORM."
 
 This effectively executes
 
-  \(apply (car COMMAND) (cdr COMMAND)\)
+  (apply (car COMMAND) (cdr COMMAND))
 
 and returns the same value, but additionally runs hooks like
 `pre-command-hook' and `post-command-hook', and sets variables
@@ -189,7 +189,7 @@ test for `called-interactively' in the command will fail."
   "Return a copy of S with all matches of REGEXPS removed.
 
 Elements of REGEXPS may also be two-element lists \(REGEXP
-SUBEXP\), where SUBEXP is the number of a subexpression in
+SUBEXP), where SUBEXP is the number of a subexpression in
 REGEXP.  In that case, only that subexpression will be removed
 rather than the entire match."
   ;; Use a temporary buffer since replace-match copies strings, which
@@ -214,8 +214,8 @@ property list, or no properties if there is no plist before it.
 
 As a simple example,
 
-\(ert-propertized-string \"foo \" '(face italic) \"bar\" \" baz\" nil \
-\" quux\"\)
+\(ert-propertized-string \"foo \" \\='(face italic) \"bar\" \" baz\" nil \
+\" quux\")
 
 would return the string \"foo bar baz quux\" where the substring
 \"bar baz\" has a `face' property with the value `italic'.
@@ -285,6 +285,46 @@ BUFFER defaults to current buffer.  Does not modify BUFFER."
             (kill-buffer clone)))))))
 
 
+(defmacro ert-with-function-mocked (name mock &rest body)
+  "Mocks function NAME with MOCK and run BODY.
+
+Once BODY finishes (be it normally by returning a value or
+abnormally by throwing or signalling), the old definition of
+function NAME is restored.
+
+BODY may further change the mock with `fset'.
+
+If MOCK is nil, the function NAME is mocked with a function
+`ert-fail'ing when called.
+
+For example:
+
+    ;; Regular use, function is mocked inside the BODY:
+    (should (eq 2 (+ 1 1)))
+    (ert-with-function-mocked ((+ (lambda (a b) (- a b))))
+      (should (eq 0 (+ 1 1))))
+    (should (eq 2 (+ 1 1)))
+
+    ;; Macro correctly recovers from a throw or signal:
+    (should
+      (catch 'done
+        (ert-with-function-mocked ((+ (lambda (a b) (- a b))))
+          (should (eq 0 (+ 1 1))))
+          (throw 'done t)))
+    (should (eq 2 (+ 1 1)))
+"
+  (declare (indent 2))
+  (let ((old-var (make-symbol "old-var"))
+        (mock-var (make-symbol "mock-var")))
+    `(let ((,old-var (symbol-function (quote ,name))) (,mock-var ,mock))
+       (fset (quote ,name)
+             (or ,mock-var (lambda (&rest _)
+                             (ert-fail (concat "`" ,(symbol-name name)
+                                               "' unexpectedly called.")))))
+       (unwind-protect
+           (progn ,@body)
+         (fset (quote ,name) ,old-var)))))
+
 (provide 'ert-x)
 
 ;;; ert-x.el ends here