GNU bug report logs - #22632
[PATCH 0/4] `ert-with-function-mocked' and refactoring `message-strip-subject-trailing-was'

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 22632 in the body.
You can then email your comments to 22632 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Michal Nazarewicz <mina86 <at> mina86.com>
To: bug-gnu-emacs <at> gnu.org
Subject: [PATCH 0/4] `ert-with-function-mocked' and refactoring
 `message-strip-subject-trailing-was'
Date: Thu, 11 Feb 2016 15:50:58 +0100

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

Message #8 received at 22632 <at> debbugs.gnu.org (full text, mbox):

From: Michal Nazarewicz <mina86 <at> mina86.com>
To: 22632 <at> debbugs.gnu.org
Subject: [PATCH 4/4] Refactor `message-strip-subject-trailing-was' function
Date: Thu, 11 Feb 2016 16:02:35 +0100

* 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

Message #11 received at 22632 <at> debbugs.gnu.org (full text, mbox):

From: Michal Nazarewicz <mina86 <at> mina86.com>
To: 22632 <at> debbugs.gnu.org
Subject: [PATCH 1/4] Introduce `ert-with-function-mocked' macro
Date: Thu, 11 Feb 2016 16:02:32 +0100

* 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.
+
 
 * 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

Message #14 received at 22632 <at> debbugs.gnu.org (full text, mbox):

From: Michal Nazarewicz <mina86 <at> mina86.com>
To: 22632 <at> debbugs.gnu.org
Subject: [PATCH 2/4] Make use of the `ert-with-function-mocked' macro
Date: Thu, 11 Feb 2016 16:02:33 +0100

* 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

Message #17 received at 22632 <at> debbugs.gnu.org (full text, mbox):

From: Michal Nazarewicz <mina86 <at> mina86.com>
To: 22632 <at> debbugs.gnu.org
Subject: [PATCH 3/4] Add test for `message-strip-subject-trailing-was'
Date: Thu, 11 Feb 2016 16:02:34 +0100

* 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

Message #20 received at 22632 <at> debbugs.gnu.org (full text, mbox):

From: Lars Ingebrigtsen <larsi <at> gnus.org>
To: Michal Nazarewicz <mina86 <at> mina86.com>
Cc: 22632 <at> debbugs.gnu.org
Subject: Re: bug#22632: [PATCH 0/4] `ert-with-function-mocked' and refactoring
 `message-strip-subject-trailing-was'
Date: Tue, 23 Feb 2016 14:49:40 +1100

Michal Nazarewicz <mina86 <at> 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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.