mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-03 08:30:09 +00:00
Remove ‘ert-with-function-mocked’ macro in favour of ‘cl-letf’ macro
* lisp/emacs-lisp/ert-x.el (ert-with-function-mocked): Remove macro in favour of ‘cl-letf’ macro which is more generic. All existing uses are migrated accordingly. The macro has not been included in an official release yet so it should be fine to delete it.
This commit is contained in:
parent
027e6fbfe4
commit
7715ee54b3
3
etc/NEWS
3
etc/NEWS
@ -411,9 +411,6 @@ by setting 'autoload-timestamps' to nil.
|
||||
FIXME As an experiment, nil is the current default.
|
||||
If no insurmountable problems before next release, it can stay that way.
|
||||
|
||||
** 'ert-with-function-mocked' of 'ert-x package allows mocking of functions
|
||||
in unit tests.
|
||||
|
||||
---
|
||||
** 'gnutls-boot' now takes a parameter :complete-negotiation that says
|
||||
that negotiation should complete even on non-blocking sockets.
|
||||
|
@ -285,46 +285,6 @@ 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 signaling), 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
|
||||
|
@ -32,7 +32,6 @@
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'ert-x)
|
||||
(require 'icalendar)
|
||||
|
||||
;; ======================================================================
|
||||
@ -64,7 +63,7 @@
|
||||
(hash (format "%d" (abs (sxhash entry-full))))
|
||||
(contents "DTSTART:19640630T070100\nblahblah")
|
||||
(username (or user-login-name "UNKNOWN_USER")))
|
||||
(ert-with-function-mocked current-time (lambda () '(1 2 3))
|
||||
(cl-letf (((symbol-function 'current-time) (lambda () '(1 2 3))))
|
||||
(should (= 77 icalendar--uid-count))
|
||||
(should (string= (concat "xxx-123-77-" hash "-" username "-19640630")
|
||||
(icalendar--create-uid entry-full contents)))
|
||||
|
@ -275,49 +275,6 @@ 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
|
||||
|
@ -57,7 +57,7 @@
|
||||
|
||||
|
||||
(ert-deftest message-strip-subject-trailing-was ()
|
||||
(ert-with-function-mocked message-talkative-question nil
|
||||
(cl-letf (((symbol-function 'message-talkative-question) nil))
|
||||
(with-temp-buffer
|
||||
(let ((no-was "Re: Foo ")
|
||||
(with-was "Re: Foo \t (was: Bar ) ")
|
||||
|
@ -25,7 +25,6 @@
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'ert-x)
|
||||
(require 'vc-bzr)
|
||||
(require 'vc-dir)
|
||||
|
||||
@ -102,7 +101,7 @@
|
||||
(while (vc-dir-busy)
|
||||
(sit-for 0.1))
|
||||
(vc-dir-mark-all-files t)
|
||||
(ert-with-function-mocked y-or-n-p (lambda (_) t)
|
||||
(cl-letf (((symbol-function 'y-or-n-p) (lambda (_) t)))
|
||||
(vc-next-action nil))
|
||||
(should (get-buffer "*vc-log*")))
|
||||
(delete-directory homedir t))))
|
||||
|
Loading…
Reference in New Issue
Block a user