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.

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 @@
22	(require 'ert)	22	(require 'ert)
23	(require 'ert-x)	23	(require 'ert-x)
24	(require 'cl-lib)	24	(require 'cl-lib)
		25	(require 'let-alist)
		26
		27	(defun overlay-tests-start-recording-modification-hooks (overlay)
		28	"Start recording modification hooks on OVERLAY.
		29
		30	Always overwrites the `insert-in-front-hooks',
		31	`modification-hooks' and `insert-behind-hooks' properties. Any
		32	recorded history from a previous call is erased.
		33
		34	The history is stored in a property on the overlay itself. Call
		35	`overlay-tests-get-recorded-modification-hooks' to retrieve the
		36	recorded calls conveniently."
		37	(dolist (hooks-property '(insert-in-front-hooks
		38	modification-hooks
		39	insert-behind-hooks))
		40	(overlay-put
		41	overlay
		42	hooks-property
		43	(list (lambda (ov &rest args)
		44	(message " %S called on %S with args %S" hooks-property ov args)
		45	(should inhibit-modification-hooks)
		46	(should (eq ov overlay))
		47	(push (list hooks-property args)
		48	(overlay-get overlay
		49	'recorded-modification-hook-calls)))))
		50	(overlay-put overlay 'recorded-modification-hook-calls nil)))
		51
		52	(defun overlay-tests-get-recorded-modification-hooks (overlay)
		53	"Extract the recorded calls made to modification hooks on OVERLAY.
		54
		55	Must be preceded by a call to
		56	`overlay-tests-start-recording-modification-hooks' on OVERLAY.
		57
		58	Returns a list. Each element of the list represents a recorded
		59	call to a particular modification hook.
		60
		61	Each call is itself a sub-list where the first element is a
		62	symbol matching the modification hook property (one of
		63	`insert-in-front-hooks', `modification-hooks' or
		64	`insert-behind-hooks') and the second element is the list of
		65	arguments passed to the hook. The first hook argument, the
		66	overlay itself, is omitted to make test result verification
		67	easier."
		68	(reverse (overlay-get overlay
		69	'recorded-modification-hook-calls)))
		70
		71	(ert-deftest overlay-modification-hooks ()
		72	"Test the basic functionality of overlay modification hooks.
		73
		74	This exercises hooks registered on the `insert-in-front-hooks',
		75	`modification-hooks' and `insert-behind-hooks' overlay
		76	properties."
		77	;; This is a data driven test loop. Each test case is described
		78	;; by an alist. The test loop initializes a new temporary buffer
		79	;; for each case, creates an overlay, registers modification hooks
		80	;; on the overlay, modifies the buffer, and then verifies which
		81	;; modification hooks (if any) were called for the overlay, as
		82	;; well as which arguments were passed to the hooks.
		83	;;
		84	;; The following keys are available in the alist:
		85	;;
		86	;; `buffer-text': the initial buffer text of the temporary buffer.
		87	;; Defaults to "1234".
		88	;;
		89	;; `overlay-beg' and `overlay-end': the begin and end positions of
		90	;; the overlay under test. Defaults to 2 and 4 respectively.
		91	;;
		92	;; `insert-at': move to the given position and insert the string
		93	;; "x" into the test case's buffer.
		94	;;
		95	;; `replace': replace the first occurrence of the given string in
		96	;; the test case's buffer with "x". The test will fail if the
		97	;; string is not found.
		98	;;
		99	;; `expected-calls': a description of the expected buffer
		100	;; modification hooks. See
		101	;; `overlay-tests-get-recorded-modification-hooks' for the format.
		102	;; May be omitted, in which case the test will insist that no
		103	;; modification hooks are called.
		104	;;
		105	;; The test will fail itself in the degenerate case where no
		106	;; buffer modifications are requested.
		107	(dolist (test-case
		108	'(
		109	;; Remember that the default buffer text is "1234" and
		110	;; the default overlay begins at position 2 and ends at
		111	;; position 4. Most of the test cases below assume
		112	;; this.
		113
		114	;; TODO: (info "(elisp) Special Properties") says this
		115	;; about `modification-hooks': "Furthermore, insertion
		116	;; will not modify any existing character, so this hook
		117	;; will only be run when removing some characters,
		118	;; replacing them with others, or changing their
		119	;; text-properties." So, why are modification-hooks
		120	;; being called when inserting at position 3 below?
		121	((insert-at . 1))
		122	((insert-at . 2)
		123	(expected-calls . ((insert-in-front-hooks (nil 2 2))
		124	(insert-in-front-hooks (t 2 3 0)))))
		125	((insert-at . 3)
		126	(expected-calls . ((modification-hooks (nil 3 3))
		127	(modification-hooks (t 3 4 0)))))
		128	((insert-at . 4)
		129	(expected-calls . ((insert-behind-hooks (nil 4 4))
		130	(insert-behind-hooks (t 4 5 0)))))
		131	((insert-at . 5))
		132
		133	;; Replacing text never calls `insert-in-front-hooks'
		134	;; or `insert-behind-hooks'. It calls
		135	;; `modification-hooks' if the overlay covers any text
		136	;; that has changed.
		137	((replace . "1"))
		138	((replace . "2")
		139	(expected-calls . ((modification-hooks (nil 2 3))
		140	(modification-hooks (t 2 3 1)))))
		141	((replace . "3")
		142	(expected-calls . ((modification-hooks (nil 3 4))
		143	(modification-hooks (t 3 4 1)))))
		144	((replace . "4"))
		145	((replace . "12")
		146	(expected-calls . ((modification-hooks (nil 1 3))
		147	(modification-hooks (t 1 2 2)))))
		148	((replace . "23")
		149	(expected-calls . ((modification-hooks (nil 2 4))
		150	(modification-hooks (t 2 3 2)))))
		151	((replace . "34")
		152	(expected-calls . ((modification-hooks (nil 3 5))
		153	(modification-hooks (t 3 4 2)))))
		154	((replace . "123")
		155	(expected-calls . ((modification-hooks (nil 1 4))
		156	(modification-hooks (t 1 2 3)))))
		157	((replace . "234")
		158	(expected-calls . ((modification-hooks (nil 2 5))
		159	(modification-hooks (t 2 3 3)))))
		160	((replace . "1234")
		161	(expected-calls . ((modification-hooks (nil 1 5))
		162	(modification-hooks (t 1 2 4)))))
		163
		164	;; Inserting at the position of a zero-length overlay
		165	;; calls both `insert-in-front-hooks' and
		166	;; `insert-behind-hooks'.
		167	((buffer-text . "") (overlay-beg . 1) (overlay-end . 1)
		168	(insert-at . 1)
		169	(expected-calls . ((insert-in-front-hooks
		170	(nil 1 1))
		171	(insert-behind-hooks
		172	(nil 1 1))
		173	(insert-in-front-hooks
		174	(t 1 2 0))
		175	(insert-behind-hooks
		176	(t 1 2 0)))))))
		177	(message "BEGIN overlay-modification-hooks test-case %S" test-case)
		178
		179	;; All three hooks ignore the overlay's `front-advance' and
		180	;; `rear-advance' option, so test both ways while expecting the same
		181	;; result.
		182	(dolist (advance '(nil t))
		183	(message " advance is %S" advance)
		184	(let-alist test-case
		185	(with-temp-buffer
		186	;; Set up the temporary buffer and overlay as specified by
		187	;; the test case.
		188	(insert (or .buffer-text "1234"))
		189	(let ((overlay (make-overlay
		190	(or .overlay-beg 2)
		191	(or .overlay-end 4)
		192	nil
		193	advance advance)))
		194	(message " (buffer-string) is %S" (buffer-string))
		195	(message " overlay is %S" overlay)
		196	(overlay-tests-start-recording-modification-hooks overlay)
		197
		198	;; Modify the buffer, possibly inducing calls to the
		199	;; overlay's modification hooks.
		200	(should (or .insert-at .replace))
		201	(when .insert-at
		202	(goto-char .insert-at)
		203	(insert "x")
		204	(message " inserted \"x\" at %S, buffer-string now %S"
		205	.insert-at (buffer-string)))
		206	(when .replace
		207	(goto-char (point-min))
		208	(search-forward .replace)
		209	(replace-match "x")
		210	(message " replaced %S with \"x\"" .replace))
		211
		212	;; Verify that the expected and actual modification hook
		213	;; calls match.
		214	(should (equal
		215	.expected-calls
		216	(overlay-tests-get-recorded-modification-hooks
		217	overlay)))))))))
25		218
26	(ert-deftest overlay-modification-hooks-message-other-buf ()	219	(ert-deftest overlay-modification-hooks-message-other-buf ()
27	"Test for bug#21824.	220	"Test for bug#21824.