Merge branch 'master' into feature/tree-sitter

1 files changed, 193 insertions, 0 deletions

diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 3c6a9208ffa..558d05de14a 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -22,6 +22,199 @@
 (require 'ert)
 (require 'ert-x)
 (require 'cl-lib)
+(require 'let-alist)
+
+(defun overlay-tests-start-recording-modification-hooks (overlay)
+  "Start recording modification hooks on OVERLAY.
+
+Always overwrites the `insert-in-front-hooks',
+`modification-hooks' and `insert-behind-hooks' properties.  Any
+recorded history from a previous call is erased.
+
+The history is stored in a property on the overlay itself.  Call
+`overlay-tests-get-recorded-modification-hooks' to retrieve the
+recorded calls conveniently."
+  (dolist (hooks-property '(insert-in-front-hooks
+                            modification-hooks
+                            insert-behind-hooks))
+    (overlay-put
+     overlay
+     hooks-property
+     (list (lambda (ov &rest args)
+             (message "  %S called on %S with args %S" hooks-property ov args)
+             (should inhibit-modification-hooks)
+             (should (eq ov overlay))
+             (push (list hooks-property args)
+                   (overlay-get overlay
+                                'recorded-modification-hook-calls)))))
+    (overlay-put overlay 'recorded-modification-hook-calls nil)))
+
+(defun overlay-tests-get-recorded-modification-hooks (overlay)
+  "Extract the recorded calls made to modification hooks on OVERLAY.
+
+Must be preceded by a call to
+`overlay-tests-start-recording-modification-hooks' on OVERLAY.
+
+Returns a list.  Each element of the list represents a recorded
+call to a particular modification hook.
+
+Each call is itself a sub-list where the first element is a
+symbol matching the modification hook property (one of
+`insert-in-front-hooks', `modification-hooks' or
+`insert-behind-hooks') and the second element is the list of
+arguments passed to the hook.  The first hook argument, the
+overlay itself, is omitted to make test result verification
+easier."
+  (reverse (overlay-get overlay
+                        'recorded-modification-hook-calls)))
+
+(ert-deftest overlay-modification-hooks ()
+  "Test the basic functionality of overlay modification hooks.
+
+This exercises hooks registered on the `insert-in-front-hooks',
+`modification-hooks' and `insert-behind-hooks' overlay
+properties."
+    ;; This is a data driven test loop.  Each test case is described
+    ;; by an alist.  The test loop initializes a new temporary buffer
+    ;; for each case, creates an overlay, registers modification hooks
+    ;; on the overlay, modifies the buffer, and then verifies which
+    ;; modification hooks (if any) were called for the overlay, as
+    ;; well as which arguments were passed to the hooks.
+    ;;
+    ;; The following keys are available in the alist:
+    ;;
+    ;; `buffer-text': the initial buffer text of the temporary buffer.
+    ;; Defaults to "1234".
+    ;;
+    ;; `overlay-beg' and `overlay-end': the begin and end positions of
+    ;; the overlay under test.  Defaults to 2 and 4 respectively.
+    ;;
+    ;; `insert-at': move to the given position and insert the string
+    ;; "x" into the test case's buffer.
+    ;;
+    ;; `replace': replace the first occurrence of the given string in
+    ;; the test case's buffer with "x".  The test will fail if the
+    ;; string is not found.
+    ;;
+    ;; `expected-calls': a description of the expected buffer
+    ;; modification hooks.  See
+    ;; `overlay-tests-get-recorded-modification-hooks' for the format.
+    ;; May be omitted, in which case the test will insist that no
+    ;; modification hooks are called.
+    ;;
+    ;; The test will fail itself in the degenerate case where no
+    ;; buffer modifications are requested.
+    (dolist (test-case
+             '(
+               ;; Remember that the default buffer text is "1234" and
+               ;; the default overlay begins at position 2 and ends at
+               ;; position 4.  Most of the test cases below assume
+               ;; this.
+
+               ;; TODO: (info "(elisp) Special Properties") says this
+               ;; about `modification-hooks': "Furthermore, insertion
+               ;; will not modify any existing character, so this hook
+               ;; will only be run when removing some characters,
+               ;; replacing them with others, or changing their
+               ;; text-properties."  So, why are modification-hooks
+               ;; being called when inserting at position 3 below?
+               ((insert-at . 1))
+               ((insert-at . 2)
+                (expected-calls . ((insert-in-front-hooks (nil 2 2))
+                                   (insert-in-front-hooks (t 2 3 0)))))
+               ((insert-at . 3)
+                (expected-calls . ((modification-hooks (nil 3 3))
+                                   (modification-hooks (t 3 4 0)))))
+               ((insert-at . 4)
+                (expected-calls . ((insert-behind-hooks (nil 4 4))
+                                   (insert-behind-hooks (t 4 5 0)))))
+               ((insert-at . 5))
+
+               ;; Replacing text never calls `insert-in-front-hooks'
+               ;; or `insert-behind-hooks'.  It calls
+               ;; `modification-hooks' if the overlay covers any text
+               ;; that has changed.
+               ((replace . "1"))
+               ((replace . "2")
+                (expected-calls . ((modification-hooks (nil 2 3))
+                                   (modification-hooks (t 2 3 1)))))
+               ((replace . "3")
+                (expected-calls . ((modification-hooks (nil 3 4))
+                                   (modification-hooks (t 3 4 1)))))
+               ((replace . "4"))
+               ((replace . "12")
+                (expected-calls . ((modification-hooks (nil 1 3))
+                                   (modification-hooks (t 1 2 2)))))
+               ((replace . "23")
+                (expected-calls . ((modification-hooks (nil 2 4))
+                                   (modification-hooks (t 2 3 2)))))
+               ((replace . "34")
+                (expected-calls . ((modification-hooks (nil 3 5))
+                                   (modification-hooks (t 3 4 2)))))
+               ((replace . "123")
+                (expected-calls . ((modification-hooks (nil 1 4))
+                                   (modification-hooks (t 1 2 3)))))
+               ((replace . "234")
+                (expected-calls . ((modification-hooks (nil 2 5))
+                                   (modification-hooks (t 2 3 3)))))
+               ((replace . "1234")
+                (expected-calls . ((modification-hooks (nil 1 5))
+                                   (modification-hooks (t 1 2 4)))))
+
+               ;; Inserting at the position of a zero-length overlay
+               ;; calls both `insert-in-front-hooks' and
+               ;; `insert-behind-hooks'.
+               ((buffer-text . "") (overlay-beg . 1) (overlay-end . 1)
+                (insert-at . 1)
+                (expected-calls . ((insert-in-front-hooks
+                                    (nil 1 1))
+                                   (insert-behind-hooks
+                                    (nil 1 1))
+                                   (insert-in-front-hooks
+                                    (t 1 2 0))
+                                   (insert-behind-hooks
+                                    (t 1 2 0)))))))
+      (message "BEGIN overlay-modification-hooks test-case %S" test-case)
+
+      ;; All three hooks ignore the overlay's `front-advance' and
+      ;; `rear-advance' option, so test both ways while expecting the same
+      ;; result.
+      (dolist (advance '(nil t))
+        (message "  advance is %S" advance)
+        (let-alist test-case
+          (with-temp-buffer
+            ;; Set up the temporary buffer and overlay as specified by
+            ;; the test case.
+            (insert (or .buffer-text "1234"))
+            (let ((overlay (make-overlay
+                            (or .overlay-beg 2)
+                            (or .overlay-end 4)
+                            nil
+                            advance advance)))
+              (message "  (buffer-string) is %S" (buffer-string))
+              (message "  overlay is %S" overlay)
+              (overlay-tests-start-recording-modification-hooks overlay)
+
+              ;; Modify the buffer, possibly inducing calls to the
+              ;; overlay's modification hooks.
+              (should (or .insert-at .replace))
+              (when .insert-at
+                (goto-char .insert-at)
+                (insert "x")
+                (message "  inserted \"x\" at %S, buffer-string now %S"
+                         .insert-at (buffer-string)))
+              (when .replace
+                (goto-char (point-min))
+                (search-forward .replace)
+                (replace-match "x")
+                (message "  replaced %S with \"x\"" .replace))
+
+              ;; Verify that the expected and actual modification hook
+              ;; calls match.
+              (should (equal
+                       .expected-calls
+                       (overlay-tests-get-recorded-modification-hooks
+                        overlay)))))))))
 
 (ert-deftest overlay-modification-hooks-message-other-buf ()
   "Test for bug#21824.