mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-28 19:42:02 +00:00
Add basic test coverage for overlay modification hooks
* test/src/buffer-tests.el: (overlay-modification-hooks) new ert-deftest. (overlay-tests-start-recording-modification-hooks): New function. (overlay-tests-get-recorded-modification-hooks): New function (bug#57150).
This commit is contained in:
Matt Armstrong
Lars Ingebrigtsen
parent
72ba9efe72
commit
5af5ed6c62
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user