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

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

[Michal Nazarewicz]

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

bug#22632: [PATCH 1/4] Introduce `ert-with-function-mocked' macro

[Michal Nazarewicz]

* 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

bug#22632: [PATCH 2/4] Make use of the `ert-with-function-mocked' macro

[Michal Nazarewicz]

* 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

bug#22632: [PATCH 3/4] Add test for `message-strip-subject-trailing-was'

[Michal Nazarewicz]

* 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

bug#22632: [PATCH 4/4] Refactor `message-strip-subject-trailing-was' function

[Michal Nazarewicz]

* 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

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

[Lars Ingebrigtsen]

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