replace-tests.el: Refactor undo tests

* test/lisp/replace-tests.el (replace-tests-bind-read-string): New variable.
(replace-tests-with-undo): Add helper macro to generate the boilerplate code.
(replace-tests--query-replace-undo, query-replace-undo-bug31073)
(query-replace-undo-bug31492, query-replace-undo-bug31538): Use it.

1 files changed, 82 insertions, 69 deletions

diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index 8123ff0a571..3fcdce6704f 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -23,6 +23,7 @@
 ;;; Code:
 
 (require 'ert)
+(eval-when-compile (require 'subr-x))
 
 (ert-deftest query-replace--split-string-tests ()
   (let ((sep (propertize "\0" 'separator t)))
@@ -358,23 +359,71 @@ Each element has the format:
 (dotimes (i (length replace-occur-tests))
   (replace-occur-test-create i))
 
+
+;;; Tests for `query-replace' undo feature.
+
+(defvar replace-tests-bind-read-string nil
+  "A string to bind `read-string' and avoid the prompt.")
+
+(defmacro replace-tests-with-undo (input from to char-nums def-chr &rest body)
+  "Helper to test `query-replace' undo feature.
+INPUT is a string to insert in a temporary buffer.
+FROM is the string to match and replace.
+TO is the replacement string.
+CHAR-NUMS is a list of elements (CHAR . NUMS), where CHAR is
+one of the characters `,', `?\\s', `u', `U', `E' or `q'
+and NUMS a list of integers.
+DEF-CHAR is the character `?\\s' or `q'.
+BODY is a list of forms to evaluate.
+
+Use CHAR-NUMS and DEF-CHAR to temporary bind the function value of
+`read-event', thus avoiding the prompt.
+For instance, if CHAR-NUMS is the lists ((?\\s . (1 2 3)) (?u . (4))),
+then replace 3 matches of FROM with TO, and undo the last replacement.
+
+Return the last evalled form in BODY."
+  (declare (indent 5) (debug (stringp stringp stringp form characterp body)))
+  (let ((text (gensym "text"))
+        (count (gensym "count")))
+    `(let* ((,text ,input)
+            (,count 0)
+            (inhibit-message t))
+       (with-temp-buffer
+         (insert ,text)
+         (goto-char 1)
+         ;; Bind `read-event' to simulate user input.
+         ;; If `replace-tests-bind-read-string' is non-nil, then
+         ;; bind `read-string' as well.
+         (cl-letf (((symbol-function 'read-event)
+                    (lambda (&rest args)
+                      (cl-incf ,count)
+                      (pcase ,count ; Build the clauses from CHAR-NUMS
+                        ,@(append
+                           (delq nil
+                                 (mapcar
+                                  (lambda (chr)
+                                    (when-let (it (alist-get chr char-nums))
+                                      (if (cdr it)
+                                          `(,(cons 'or it) ,chr)
+                                        `(,(car it) ,chr))))
+                                  '(?, ?\s ?u ?U ?E ?q)))
+                           `((_ ,def-chr))))))
+                   ((symbol-function 'read-string)
+                    (if replace-tests-bind-read-string
+                        (lambda (&rest args) replace-tests-bind-read-string)
+                      (symbol-function 'read-string))))
+           (perform-replace ,from ,to t t nil))
+         ,@body))))
+
 (defun replace-tests--query-replace-undo (&optional comma)
-  (with-temp-buffer
-    (insert "111")
-    (goto-char 1)
-    (let ((count 0))
-      ;; Don't wait for user input.
-      (cl-letf (((symbol-function 'read-event)
-                 (lambda (&rest args)
-                   (cl-incf count)
-                   (let ((val (pcase count
-                                ('2 (if comma ?, ?\s)) ; replace and: ',' no move; '\s' go next
-                                ('3 ?u) ; undo
-                                ('4 ?q) ; exit
-                                (_ ?\s)))) ; replace current and go next
-                     val))))
-        (perform-replace "1" "2" t nil nil)))
-    (buffer-string)))
+  (let ((input "111"))
+    (if comma
+        (should
+         (replace-tests-with-undo
+          input "1" "2" ((?, . (2)) (?u . (3)) (?q . (4))) ?\s (buffer-string)))
+      (should
+       (replace-tests-with-undo
+        input "1" "2" ((?\s . (2)) (?u . (3)) (?q . (4))) ?\s (buffer-string))))))
 
 (ert-deftest query-replace--undo ()
   (should (string= "211" (replace-tests--query-replace-undo)))
@@ -382,64 +431,28 @@ Each element has the format:
 
 (ert-deftest query-replace-undo-bug31073 ()
   "Test for https://debbugs.gnu.org/31073 ."
-  (let ((text "aaa aaa")
-        (count 0))
-    (with-temp-buffer
-      (insert text)
-      (goto-char 1)
-      (cl-letf (((symbol-function 'read-event)
-                 (lambda (&rest args)
-                   (cl-incf count)
-                   (let ((val (pcase count
-                                ((or 1 2 3) ?\s) ; replace current and go next
-                                (4 ?U) ; undo-all
-                                (_ ?q)))) ; exit
-                     val))))
-        (perform-replace "a" "B" t nil nil))
-      ;; After undo text must be the same.
-      (should (string= text (buffer-string))))))
+  (let ((input "aaa aaa"))
+    (should
+     (replace-tests-with-undo
+      input "a" "B" ((?\s . (1 2 3)) (?U . (4))) ?q
+      (string= input (buffer-string))))))
 
 (ert-deftest query-replace-undo-bug31492 ()
   "Test for https://debbugs.gnu.org/31492 ."
-  (let ((text "a\nb\nc\n")
-        (count 0)
-        (inhibit-message t))
-    (with-temp-buffer
-      (insert text)
-      (goto-char 1)
-      (cl-letf (((symbol-function 'read-event)
-                 (lambda (&rest args)
-                   (cl-incf count)
-                   (let ((val (pcase count
-                                ((or 1 2) ?\s) ; replace current and go next
-                                (3 ?U) ; undo-all
-                                (_ ?q)))) ; exit
-                     val))))
-        (perform-replace "^\\|\b\\|$" "foo" t t nil))
-      ;; After undo text must be the same.
-      (should (string= text (buffer-string))))))
+  (let ((input "a\nb\nc\n"))
+    (should
+     (replace-tests-with-undo
+      input "^\\|\b\\|$" "foo" ((?\s . (1 2)) (?U . (3))) ?q
+      (string= input (buffer-string))))))
 
 (ert-deftest query-replace-undo-bug31538 ()
   "Test for https://debbugs.gnu.org/31538 ."
-  (let ((text "aaa aaa")
-        (count 0)
-        (inhibit-message t))
-    (with-temp-buffer
-      (insert text)
-      (goto-char 1)
-      (cl-letf (((symbol-function 'read-event)
-                 (lambda (&rest args)
-                   (cl-incf count)
-                   (let ((val (pcase count
-                                ((or 1 2 3) ?\s) ; replace current and go next
-                                (4 ?E) ; edit string
-                                (5 ?U) ; undo-all
-                                (_ ?q)))) ; exit
-                     val)))
-                ((symbol-function 'read-string)
-                 (lambda (&rest _) "Bfoo")))
-        (perform-replace "a" "B" t t nil))
-      ;; After undo text must be the same.
-      (should (string= text (buffer-string))))))
+  (let ((input "aaa aaa")
+        (replace-tests-bind-read-string "Bfoo"))
+    (should
+     (replace-tests-with-undo
+      input "a" "B" ((?\s . (1 2 3)) (?E . (4)) (?U . (5))) ?q
+      (string= input (buffer-string))))))
+
 
 ;;; replace-tests.el ends here