* bug#22632: [PATCH 0/4] `ert-with-function-mocked' and refactoring `message-strip-subject-trailing-was'
@ 2016-02-11 14:50 Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 1/4] Introduce `ert-with-function-mocked' macro Michal Nazarewicz
2016-02-23 3:49 ` bug#22632: [PATCH 0/4] `ert-with-function-mocked' and refactoring `message-strip-subject-trailing-was' Lars Ingebrigtsen
0 siblings, 2 replies; 6+ messages in thread
From: Michal Nazarewicz @ 2016-02-11 14:50 UTC (permalink / raw
To: 22632
I started with refactoring `message-strip-subject-trailing-was'
function but ended up also including `ert-with-function-mocked' macro
which lead to two changes in existing unit-tests.
Michal Nazarewicz (4):
Introduce `ert-with-function-mocked' macro
Make use of the `ert-with-function-mocked' macro
Add test for `message-strip-subject-trailing-was'
Refactor `message-strip-subject-trailing-was' function
etc/NEWS | 3 +++
lisp/emacs-lisp/ert-x.el | 40 +++++++++++++++++++++++++++++
lisp/gnus/message.el | 47 +++++++++++++++--------------------
test/lisp/calendar/icalendar-tests.el | 20 ++++++---------
test/lisp/emacs-lisp/ert-x-tests.el | 43 ++++++++++++++++++++++++++++++++
test/lisp/gnus/message-tests.el | 43 ++++++++++++++++++++++++++++++++
test/lisp/vc/vc-bzr-tests.el | 9 +++----
7 files changed, 159 insertions(+), 46 deletions(-)
--
2.7.0.rc3.207.g0ac5344
^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#22632: [PATCH 1/4] Introduce `ert-with-function-mocked' macro
2016-02-11 14:50 bug#22632: [PATCH 0/4] `ert-with-function-mocked' and refactoring `message-strip-subject-trailing-was' Michal Nazarewicz
@ 2016-02-11 15:02 ` Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 2/4] Make use of the " Michal Nazarewicz
` (2 more replies)
2016-02-23 3:49 ` bug#22632: [PATCH 0/4] `ert-with-function-mocked' and refactoring `message-strip-subject-trailing-was' Lars Ingebrigtsen
1 sibling, 3 replies; 6+ messages in thread
From: Michal Nazarewicz @ 2016-02-11 15:02 UTC (permalink / raw
To: 22632
* lisp/emacs-lisp/ert-x.el (ert-with-function-mocked): New macro which
allows evaluating code while particular function is replaced with
a mock. The original definition of said function is restored once the
macro finishes.
---
etc/NEWS | 3 +++
lisp/emacs-lisp/ert-x.el | 40 ++++++++++++++++++++++++++++++++++
test/lisp/emacs-lisp/ert-x-tests.el | 43 +++++++++++++++++++++++++++++++++++++
3 files changed, 86 insertions(+)
diff --git a/etc/NEWS b/etc/NEWS
index 37eb2bc..ac418be7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -88,6 +88,9 @@ different group ID.
** Autoload files can be generated without timestamps,
by setting `autoload-timestamps' to nil.
+** `ert-with-function-mocked' of 'ert-x package allows mocking of functions
+in unit tests.
+
\f
* Changes in Emacs 25.2 on Non-Free Operating Systems
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 2a2418f..eb10c84 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -285,6 +285,46 @@ ert-buffer-string-reindented
(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
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el
index ef8642a..a2665e7 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -275,6 +275,49 @@ ert--hash-table-to-alist
(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
--
2.7.0.rc3.207.g0ac5344
^ permalink raw reply related [flat|nested] 6+ messages in thread
* bug#22632: [PATCH 2/4] Make use of the `ert-with-function-mocked' macro
2016-02-11 15:02 ` bug#22632: [PATCH 1/4] Introduce `ert-with-function-mocked' macro Michal Nazarewicz
@ 2016-02-11 15:02 ` Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 3/4] Add test for `message-strip-subject-trailing-was' Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 4/4] Refactor `message-strip-subject-trailing-was' function Michal Nazarewicz
2 siblings, 0 replies; 6+ messages in thread
From: Michal Nazarewicz @ 2016-02-11 15:02 UTC (permalink / raw
To: 22632
* test/lisp/calendar/icalendar-tests.el (icalendar--create-uid):
* test/lisp/vc/vc-bzr-tests.el (vc-bzr-test-bug9781): Use
`ert-with-function-mocked' instead of implementing the fragile
`unwind-protect' logic openly.
---
test/lisp/calendar/icalendar-tests.el | 20 +++++++-------------
test/lisp/vc/vc-bzr-tests.el | 9 +++------
2 files changed, 10 insertions(+), 19 deletions(-)
diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el
index 2c13a36..20d8834 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -32,6 +32,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'icalendar)
;; ======================================================================
@@ -58,23 +59,16 @@ icalendar-tests--trim
(ert-deftest icalendar--create-uid ()
"Test for `icalendar--create-uid'."
(let* ((icalendar-uid-format "xxx-%t-%c-%h-%u-%s")
- t-ct
(icalendar--uid-count 77)
(entry-full "30.06.1964 07:01 blahblah")
(hash (format "%d" (abs (sxhash entry-full))))
(contents "DTSTART:19640630T070100\nblahblah")
- (username (or user-login-name "UNKNOWN_USER"))
- )
- (fset 't-ct (symbol-function 'current-time))
- (unwind-protect
- (progn
- (fset '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)))
- (should (= 78 icalendar--uid-count)))
- ;; restore 'current-time
- (fset 'current-time (symbol-function 't-ct)))
+ (username (or user-login-name "UNKNOWN_USER")))
+ (ert-with-function-mocked 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)))
+ (should (= 78 icalendar--uid-count)))
(setq contents "blahblah")
(setq icalendar-uid-format "yyy%syyy")
(should (string= (concat "yyyDTSTARTyyy")
diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el
index 82721ee..98d176c 100644
--- a/test/lisp/vc/vc-bzr-tests.el
+++ b/test/lisp/vc/vc-bzr-tests.el
@@ -25,6 +25,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'vc-bzr)
(require 'vc-dir)
@@ -101,12 +102,8 @@
(while (vc-dir-busy)
(sit-for 0.1))
(vc-dir-mark-all-files t)
- (let ((f (symbol-function 'y-or-n-p)))
- (unwind-protect
- (progn
- (fset 'y-or-n-p (lambda (prompt) t))
- (vc-next-action nil))
- (fset 'y-or-n-p f)))
+ (ert-with-function-mocked y-or-n-p (lambda (_) t)
+ (vc-next-action nil))
(should (get-buffer "*vc-log*")))
(delete-directory homedir t))))
--
2.7.0.rc3.207.g0ac5344
^ permalink raw reply related [flat|nested] 6+ messages in thread
* bug#22632: [PATCH 3/4] Add test for `message-strip-subject-trailing-was'
2016-02-11 15:02 ` bug#22632: [PATCH 1/4] Introduce `ert-with-function-mocked' macro Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 2/4] Make use of the " Michal Nazarewicz
@ 2016-02-11 15:02 ` Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 4/4] Refactor `message-strip-subject-trailing-was' function Michal Nazarewicz
2 siblings, 0 replies; 6+ messages in thread
From: Michal Nazarewicz @ 2016-02-11 15:02 UTC (permalink / raw
To: 22632
* test/lisp/gnus/message-test.el (message-strip-subject-trailing-was):
New test.
---
test/lisp/gnus/message-tests.el | 43 +++++++++++++++++++++++++++++++++++++++++
1 file changed, 43 insertions(+)
diff --git a/test/lisp/gnus/message-tests.el b/test/lisp/gnus/message-tests.el
index 3afa156..ae34f24 100644
--- a/test/lisp/gnus/message-tests.el
+++ b/test/lisp/gnus/message-tests.el
@@ -55,6 +55,49 @@
(point)))))
(set-buffer-modified-p nil))))
+
+(ert-deftest message-strip-subject-trailing-was ()
+ (ert-with-function-mocked message-talkative-question nil
+ (with-temp-buffer
+ (let ((no-was "Re: Foo ")
+ (with-was "Re: Foo \t (was: Bar ) ")
+ (stripped-was "Re: Foo")
+ reply)
+
+ ;; Test unconditional stripping
+ (setq-local message-subject-trailing-was-query t)
+ (should (string= no-was (message-strip-subject-trailing-was no-was)))
+ (should (string= stripped-was
+ (message-strip-subject-trailing-was with-was)))
+
+ ;; Test asking
+ (setq-local message-subject-trailing-was-query 'ask)
+ (fset 'message-talkative-question
+ (lambda (_ question show text)
+ (should (string= "Strip `(was: <old subject>)' in subject? "
+ question))
+ (should show)
+ (should (string-match
+ (concat
+ "Strip `(was: <old subject>)' in subject "
+ "and use the new one instead\\?\n\n"
+ "Current subject is: \"\\(.*\\)\"\n\n"
+ "New subject would be: \"\\(.*\\)\"\n\n"
+ "See the variable "
+ "`message-subject-trailing-was-query' "
+ "to get rid of this query.")
+ text))
+ (should (string= (match-string 1 text) with-was))
+ (should (string= (match-string 2 text) stripped-was))
+ reply))
+ (message-strip-subject-trailing-was with-was)
+ (should (string= with-was
+ (message-strip-subject-trailing-was with-was)))
+ (setq reply t)
+ (should (string= stripped-was
+ (message-strip-subject-trailing-was with-was)))))))
+
+
(provide 'message-mode-tests)
;;; message-mode-tests.el ends here
--
2.7.0.rc3.207.g0ac5344
^ permalink raw reply related [flat|nested] 6+ messages in thread
* bug#22632: [PATCH 4/4] Refactor `message-strip-subject-trailing-was' function
2016-02-11 15:02 ` bug#22632: [PATCH 1/4] Introduce `ert-with-function-mocked' macro Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 2/4] Make use of the " Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 3/4] Add test for `message-strip-subject-trailing-was' Michal Nazarewicz
@ 2016-02-11 15:02 ` Michal Nazarewicz
2 siblings, 0 replies; 6+ messages in thread
From: Michal Nazarewicz @ 2016-02-11 15:02 UTC (permalink / raw
To: 22632
* lisp/gnus/message.el (message-strip-subject-trailing-was): Refactor
the function replacing sequence of `if' calls with a mixture of `or'
and `and' calls instead. This makes it shorter and containing less
internal state thus easier to follow.
---
lisp/gnus/message.el | 47 ++++++++++++++++++++---------------------------
1 file changed, 20 insertions(+), 27 deletions(-)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index fee7937..31caeb9 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -2220,33 +2220,26 @@ message-strip-subject-trailing-was
"Remove trailing \"(was: <old subject>)\" from SUBJECT lines.
Leading \"Re: \" is not stripped by this function. Use the function
`message-strip-subject-re' for this."
- (let* ((query message-subject-trailing-was-query)
- (new) (found))
- (setq found
- (string-match
- (if (eq query 'ask)
- message-subject-trailing-was-ask-regexp
- message-subject-trailing-was-regexp)
- subject))
- (if found
- (setq new (substring subject 0 (match-beginning 0))))
- (if (or (not found) (eq query nil))
- subject
- (if (eq query 'ask)
- (if (message-y-or-n-p
- "Strip `(was: <old subject>)' in subject? " t
- (concat
- "Strip `(was: <old subject>)' in subject "
- "and use the new one instead?\n\n"
- "Current subject is: \""
- subject "\"\n\n"
- "New subject would be: \""
- new "\"\n\n"
- "See the variable `message-subject-trailing-was-query' "
- "to get rid of this query."
- ))
- new subject)
- new))))
+ (or
+ (let ((query message-subject-trailing-was-query) new)
+ (and query
+ (string-match (if (eq query 'ask)
+ message-subject-trailing-was-ask-regexp
+ message-subject-trailing-was-regexp)
+ subject)
+ (setq new (substring subject 0 (match-beginning 0)))
+ (or (not (eq query 'ask))
+ (message-y-or-n-p
+ "Strip `(was: <old subject>)' in subject? " t
+ (concat
+ "Strip `(was: <old subject>)' in subject "
+ "and use the new one instead?\n\n"
+ "Current subject is: \"" subject "\"\n\n"
+ "New subject would be: \"" new "\"\n\n"
+ "See the variable `message-subject-trailing-was-query' "
+ "to get rid of this query.")))
+ new))
+ subject))
;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/
--
2.7.0.rc3.207.g0ac5344
^ permalink raw reply related [flat|nested] 6+ messages in thread
* bug#22632: [PATCH 0/4] `ert-with-function-mocked' and refactoring `message-strip-subject-trailing-was'
2016-02-11 14:50 bug#22632: [PATCH 0/4] `ert-with-function-mocked' and refactoring `message-strip-subject-trailing-was' Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 1/4] Introduce `ert-with-function-mocked' macro Michal Nazarewicz
@ 2016-02-23 3:49 ` Lars Ingebrigtsen
1 sibling, 0 replies; 6+ messages in thread
From: Lars Ingebrigtsen @ 2016-02-23 3:49 UTC (permalink / raw
To: Michal Nazarewicz; +Cc: 22632
Michal Nazarewicz <mina86@mina86.com> writes:
> I started with refactoring `message-strip-subject-trailing-was'
> function but ended up also including `ert-with-function-mocked' macro
> which lead to two changes in existing unit-tests.
>
> Michal Nazarewicz (4):
> Introduce `ert-with-function-mocked' macro
> Make use of the `ert-with-function-mocked' macro
> Add test for `message-strip-subject-trailing-was'
> Refactor `message-strip-subject-trailing-was' function
Thanks; applied to master.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2016-02-23 3:49 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-02-11 14:50 bug#22632: [PATCH 0/4] `ert-with-function-mocked' and refactoring `message-strip-subject-trailing-was' Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 1/4] Introduce `ert-with-function-mocked' macro Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 2/4] Make use of the " Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 3/4] Add test for `message-strip-subject-trailing-was' Michal Nazarewicz
2016-02-11 15:02 ` bug#22632: [PATCH 4/4] Refactor `message-strip-subject-trailing-was' function Michal Nazarewicz
2016-02-23 3:49 ` bug#22632: [PATCH 0/4] `ert-with-function-mocked' and refactoring `message-strip-subject-trailing-was' Lars Ingebrigtsen
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.