bug#31538: 26.1; query-replace undo fails if user edits the replacement string

[Tino Calancha]

Tino Calancha <tino.calancha@gmail.com> writes:

> Tino Calancha <tino.calancha@gmail.com> writes:
>
>> M-<
>> M-% is RET foo RET SPC E bar RET U
>> ;; Just drop 'foo' but keeps 'bar'.
>
> Update the replacement string after the user has input
> the new value.
>
> commit 5655739cedb02946dd16071a64e51fcab08abf8b
> Author: Tino Calancha <tino.calancha@gmail.com>
> Date:   Sun May 20 21:32:55 2018 +0900
>
>     Fix Bug#31538
>     
>     * lisp/replace.el (perform-replace): Update the replacement string
>     after the user edit it.
I want to add a test for this bug.
It turned out that tests for `query-replace' undo feature follow
same pattern:

* Temporary bind `read-event' to a lambda with a `pcase'.
* Call `perform-replace'
* compare initial input with current buffer.

I want to add a macro to create that code and avoid repetition.

If no objections, I want to push following patch during the weekend:
--8<-----------------------------cut here---------------start------------->8---
commit 95ab9b42c6eaa76e5e1e14cb282eb0c05bc1d57a
Author: Tino Calancha <tino.calancha@gmail.com>
Date:   Wed May 23 18:37:43 2018 +0900

    Fix Bug#31538
    
    * lisp/replace.el (perform-replace): Update the replacement string
    after the user edit it.
    
    * test/lisp/replace-tests.el (replace-tests-clauses): New function.
    (replace-tests-bind-read-string): New variable.
    (replace-tests-with-undo): Macro to create boilerplate code.
    (query-replace-undo-bug31073): Use it.
    (query-replace-undo-bug31538): New test.

diff --git a/lisp/replace.el b/lisp/replace.el
index a17dd19b0d..20b868a765 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -2805,7 +2805,8 @@ perform-replace
                                 (replace-match-maybe-edit
                                  next-replacement nocasify literal noedit
                                  real-match-data backward)
-                                replaced t))
+                                replaced t)
+                          (setq next-replacement-replaced next-replacement))
                         (setq done t))
 
                        ((eq def 'delete-and-edit)
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index 40ee838e67..761518dbef 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,75 @@ replace-occur-test-create
 (dotimes (i (length replace-occur-tests))
   (replace-occur-test-create i))
 
+
+;;; Tests for `query-replace' undo feature.
+(defun replace-tests-clauses (char-nums def-chr)
+  "Build the clauses of the `pcase' in `replace-tests-with-undo'.
+CHAR-NUMS is a list of elements (CHAR . NUMS).
+CHAR is one of the chars ?, ?\s ?u ?U ?E ?q.
+NUMS is a list of integers; they are the patters to match,
+while CHAR is the return value.
+DEF-CHAR is the default character to return in the `pcase'
+when any of the clauses match."
+  (append
+   (delq nil
+         (mapcar (lambda (chr)
+                   (when-let (it (cadr (assq chr char-nums)))
+                     (if (cdr it)
+                         `(,(cons 'or it) ,chr)
+                       `(,(car it) ,chr))))
+                 '(?, ?\s ?u ?U ?E ?q)))
+   `((_ ,def-chr))))
+
+(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 for replace.
+TO is the replacement string.
+CHAR-NUMS is a list of elements (CHAR . NUMS).
+CHAR is one of the chars ?, ?\s ?u ?U ?E ?q.
+NUMS is a list of integers.
+DEF-CHAR is the char ?\s or ?q.
+BODY is a list of forms.
+Return the last evaled 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)
+                      (let ((val
+                             (pcase ,count
+                               ,@(replace-tests-clauses char-nums def-chr))))
+                        val)))
+                   ((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,42 +435,28 @@ replace-tests--query-replace-undo
 
 (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 ((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

--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 27.0.50 (build 38, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
 of 2018-05-23 built on calancha-pc
Repository revision: bab73230d1be1fe394b7269c1365ef6fb1a5d9b3