X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c043d9731b499a241830d705e9055c9e42ccf28c..368cb23fe249334bf9d230755ae07b6410ac6852:/test/lisp/emacs-lisp/ert-x-tests.el

diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el
index 660a1cb218..a2665e7c39 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -1,6 +1,6 @@
 ;;; ert-x-tests.el --- Tests for ert-x.el
 
-;; Copyright (C) 2008, 2010-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2010-2016 Free Software Foundation, Inc.
 
 ;; Author: Phil Hagelberg
 ;; 	   Christian Ohler <ohler@gnu.org>
@@ -275,6 +275,49 @@ desired effect."
              (should (equal (c x) (lisp x))))))
 
 
+(defun ert--dummy-id (a)
+  "Identity function.  Used for tests only."
+  a)
+
+(ert-deftest ert-with-function-mocked ()
+  (let ((mock-id  (lambda (_) 21)))
+    (should (eq 42 (ert--dummy-id 42)))
+
+    (ert-with-function-mocked ert--dummy-id nil
+       (fset 'ert--dummy-id mock-id)
+       (should (eq 21 (ert--dummy-id 42))))
+    (should (eq 42 (ert--dummy-id 42)))
+
+    (ert-with-function-mocked ert--dummy-id mock-id
+       (should (eq 21 (ert--dummy-id 42))))
+    (should (eq 42 (ert--dummy-id 42)))
+
+    (should
+     (catch 'exit
+       (ert-with-function-mocked ert--dummy-id mock-id
+         (should (eq 21 (ert--dummy-id 42))))
+         (throw 'exit t)))
+    (should (eq 42 (ert--dummy-id 42)))
+
+    (should
+     (string= "Foo"
+              (condition-case err
+                  (progn
+                    (ert-with-function-mocked ert--dummy-id mock-id
+                      (should (eq 21 (ert--dummy-id 42))))
+                    (user-error "Foo"))
+                (user-error (cadr err)))))
+    (should (eq 42 (ert--dummy-id 42)))
+
+    (should
+     (string= "`ert--dummy-id' unexpectedly called."
+              (condition-case err
+                  (ert-with-function-mocked ert--dummy-id nil
+                    (ert--dummy-id 42))
+                (ert-test-failed (cadr err)))))
+    (should (eq 42 (ert--dummy-id 42)))))
+
+
 (provide 'ert-x-tests)
 
 ;;; ert-x-tests.el ends here