From 5c9895fffe4e34b7a31b0a8e4bce0b59a4bc0326 Mon Sep 17 00:00:00 2001 From: Matt Armstrong Date: Tue, 1 Nov 2022 19:40:20 -0700 Subject: [PATCH] Add a test for overlay evaporation across indirect buffers * test/src/buffer-tests.el (buffer-tests--overlays-indirect-evaporate): Test evaporation of overlays triggered by deleting text in base and in indirect buffers. Test doesn't pass at the moment. --- test/src/buffer-tests.el | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 0e9e84ef7a1..3c371760952 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -296,6 +296,42 @@ with parameters from the *Messages* buffer modification." (should (equal (overlay-start ol1) (overlay-start ol2))) (should (equal (overlay-end ol1) (overlay-end ol2)))))) +(ert-deftest buffer-tests--overlays-indirect-evaporate () + "Verify that deleting text evaporates overlays in every related buffer. + +Deleting characters from either a base or an indirect buffer +should evaporate overlays in both." + :expected-result :failed + ;; Loop twice, erasing from the base buffer the first time and the + ;; indirect buffer the second. + (dolist (erase-where '(base indirect)) + (ert-info ((format "erase-where %S" erase-where)) + (with-temp-buffer + (insert "xxx") + (let* ((beg 2) + (end 3) + (base (current-buffer)) + (base-overlay (make-overlay beg end base)) + (indirect (make-indirect-buffer + base + (generate-new-buffer-name + (concat (buffer-name base) "-indirect")))) + (indirect-overlay (make-overlay beg end indirect))) + (overlay-put base-overlay 'evaporate t) + (overlay-put indirect-overlay 'evaporate t) + (with-current-buffer (pcase-exhaustive erase-where + (`base base) + (`indirect indirect)) + (delete-region beg end)) + (ert-info ((prin1-to-string + `(,base ,base-overlay ,indirect ,indirect-overlay))) + (should (not (buffer-live-p (overlay-buffer base-overlay)))) + (should (not (buffer-live-p (overlay-buffer indirect-overlay)))) + (should (equal nil (with-current-buffer base + (overlays-in (point-min) (point-max))))) + (should (equal nil (with-current-buffer indirect + (overlays-in (point-min) (point-max))))))))))) + (ert-deftest overlay-evaporation-after-killed-buffer () (let* ((ols (with-temp-buffer (insert "toto") -- 2.39.2