emacs-29 d76d7a3beb: whitespace: Avoid mutating original buffer's markers in clones

[Eli Zaretskii]

branch: emacs-29
commit d76d7a3bebf1ff0b06a38f7f96d316752844ed10
Author: Richard Hansen <rhansen@rhansen.org>
Commit: Eli Zaretskii <eliz@gnu.org>

    whitespace: Avoid mutating original buffer's markers in clones
    
    * lisp/whitespace.el (whitespace--clone): New hook function that is
    run after cloning a buffer that copies `whitespace-bob-marker' and
    `whitespace-eob-marker' and changes the copies to point to the new
    buffer (Bug#59618).
    (whitespace-color-on): Register the hook function.
    (whitespace-color-off): Unregister the hook function.
    
    * test/lisp/whitespace-tests.el
    (whitespace-tests--with-test-buffer): New macro.
    (whitespace-tests--check-markers): New function.
    (whitespace-tests--indirect-clone-breaks-base-markers)
    (whitespace-tests--indirect-clone-markers)
    (whitespace-tests--regular-clone-markers): New tests.
---
 lisp/whitespace.el            | 15 +++++++++
 test/lisp/whitespace-tests.el | 75 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 90 insertions(+)

diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 9bc6ad9db4..558be1841a 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -2093,6 +2093,17 @@ resultant list will be returned."
        t))
 
 
+(defun whitespace--clone ()
+  "Hook function run after `make-indirect-buffer' and `clone-buffer'."
+  (when (whitespace-style-face-p)
+    (setq-local whitespace-bob-marker
+                (copy-marker (marker-position whitespace-bob-marker)
+                             (marker-insertion-type whitespace-bob-marker)))
+    (setq-local whitespace-eob-marker
+                (copy-marker (marker-position whitespace-eob-marker)
+                             (marker-insertion-type whitespace-eob-marker)))))
+
+
 (defun whitespace-color-on ()
   "Turn on color visualization."
   (when (whitespace-style-face-p)
@@ -2111,6 +2122,8 @@ resultant list will be returned."
               ;; The -1 ensures that it runs before any
               ;; `font-lock-mode' hook functions.
               -1 t)
+    (add-hook 'clone-buffer-hook #'whitespace--clone nil t)
+    (add-hook 'clone-indirect-buffer-hook #'whitespace--clone nil t)
     ;; Add whitespace-mode color into font lock.
     (setq
      whitespace-font-lock-keywords
@@ -2204,6 +2217,8 @@ resultant list will be returned."
     (remove-hook 'before-change-functions #'whitespace-buffer-changed t)
     (remove-hook 'after-change-functions #'whitespace--update-bob-eob
                  t)
+    (remove-hook 'clone-buffer-hook #'whitespace--clone t)
+    (remove-hook 'clone-indirect-buffer-hook #'whitespace--clone t)
     (font-lock-remove-keywords nil whitespace-font-lock-keywords)
     (font-lock-flush)))
 
diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el
index 3e94d7e921..12f6cb99a2 100644
--- a/test/lisp/whitespace-tests.el
+++ b/test/lisp/whitespace-tests.el
@@ -42,6 +42,13 @@ nil, `whitespace-mode' is left disabled."
           '(whitespace-mode 1))
        ,@body)))
 
+(defmacro whitespace--with-buffer-selected (buffer-or-name &rest body)
+  (declare (debug (form body)) (indent 1))
+  `(save-window-excursion
+     (with-current-buffer (or ,buffer-or-name (current-buffer))
+       (with-selected-window (display-buffer (current-buffer))
+         ,@body))))
+
 (defun whitespace-tests--faceup (&rest lines)
   "Convenience wrapper around `faceup-test-font-lock-buffer'.
 Returns non-nil if the concatenated LINES match the current
@@ -337,6 +344,74 @@ buffer's content."
       (whitespace-mode 1)
       (should (not (buffer-modified-p))))))
 
+(ert-deftest whitespace-tests--indirect-clone-breaks-base-markers ()
+  "Specific regression test for Bug#59618."
+  (whitespace-tests--with-test-buffer '(face empty)
+    (insert "\nx\n\n")
+    (let ((base (current-buffer))
+          ;; `unwind-protect' is not used to clean up `indirect'
+          ;; because the buffer should only be killed on success.
+          (indirect (clone-indirect-buffer (buffer-name) nil)))
+      (should (eq (marker-buffer whitespace-bob-marker) base))
+      (should (eq (marker-buffer whitespace-eob-marker) base))
+      (whitespace--with-buffer-selected indirect
+        ;; Mutate the indirect buffer to update its bob/eob markers.
+        (execute-kbd-macro (kbd "z RET M-< a")))
+      ;; With Bug#59618, the above mutation would cause the base
+      ;; buffer's markers to point inside the indirect buffer because
+      ;; the indirect buffer erroneously shared marker objects with
+      ;; the base buffer.  Killing the indirect buffer would then
+      ;; invalidate those markers (make them point nowhere).
+      (kill-buffer indirect)
+      (should (eq (marker-buffer whitespace-bob-marker) base))
+      (should (eq (marker-buffer whitespace-eob-marker) base)))))
+
+(defun whitespace-tests--check-markers (buf bpos epos)
+  (with-current-buffer buf
+    (should (eq (marker-buffer whitespace-bob-marker) buf))
+    (should (eq (marker-position whitespace-bob-marker) bpos))
+    (should (eq (marker-buffer whitespace-eob-marker) buf))
+    (should (eq (marker-position whitespace-eob-marker) epos))))
+
+(ert-deftest whitespace-tests--indirect-clone-markers ()
+  "Test `whitespace--clone' on indirect clones."
+  (whitespace-tests--with-test-buffer '(face empty)
+    (insert "\nx\n\n")
+    (let ((base (current-buffer))
+          ;; `unwind-protect' is not used to clean up `indirect'
+          ;; because the buffer should only be killed on success.
+          (indirect (clone-indirect-buffer nil nil)))
+      (whitespace-tests--check-markers base 2 4)
+      (whitespace--with-buffer-selected indirect
+        (whitespace-tests--check-markers indirect 2 4)
+        ;; Mutate the buffer to trigger `after-change-functions' and
+        ;; thus `whitespace--update-bob-eob'.
+        (execute-kbd-macro (kbd "z RET M-< a"))
+        (whitespace-tests--check-markers indirect 1 8))
+      (kill-buffer indirect)
+      ;; When the buffer was modified above, the new "a" character at
+      ;; the beginning moved the base buffer's markers by one.  Emacs
+      ;; did not run the base buffer's `after-change-functions' after
+      ;; the indirect buffer was edited (Bug#46982), so the end result
+      ;; is just the shift by one.
+      (whitespace-tests--check-markers base 3 5))))
+
+(ert-deftest whitespace-tests--regular-clone-markers ()
+  "Test `whitespace--clone' on regular clones."
+  (whitespace-tests--with-test-buffer '(face empty)
+    (insert "\nx\n\n")
+    (let ((orig (current-buffer))
+          ;; `unwind-protect' is not used to clean up `clone' because
+          ;; the buffer should only be killed on success.
+          (clone (clone-buffer)))
+      (whitespace-tests--check-markers orig 2 4)
+      (whitespace--with-buffer-selected clone
+        (whitespace-tests--check-markers clone 2 4)
+        (execute-kbd-macro (kbd "z RET M-< a"))
+        (whitespace-tests--check-markers clone 1 8))
+      (kill-buffer clone)
+      (whitespace-tests--check-markers orig 2 4))))
+
 (provide 'whitespace-tests)
 
 ;;; whitespace-tests.el ends here