mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-22 07:09:54 +00:00
Code Issues Releases Activity

whitespace: Avoid mutating original buffer's markers in clones

Browse Source 
* 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.
This commit is contained in:
Richard Hansen 2022-12-13 01:33:43 -05:00 committed by Eli Zaretskii
parent 12b2b8864c
commit d76d7a3beb
2 changed files with 90 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
lisp/whitespace.el
View File

@ -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)))

75
test/lisp/whitespace-tests.el
View File

@ -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