From: Richard Hansen Date: Tue, 13 Dec 2022 06:33:43 +0000 (-0500) Subject: whitespace: Avoid mutating original buffer's markers in clones X-Git-Tag: emacs-29.0.90~1056 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d76d7a3bebf1ff0b06a38f7f96d316752844ed10;p=emacs.git 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. --- diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 9bc6ad9db46..558be1841ab 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 3e94d7e921b..12f6cb99a23 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