1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-26 23:31:55 -08:00
emacs/test/src/buffer-tests.el
Paul Eggert ba05d005e5 Update copyright year to 2021
Run "TZ=UTC0 admin/update-copyright".
2021-01-01 01:13:56 -08:00

1364 lines
54 KiB
EmacsLisp

;;; buffer-tests.el --- tests for buffer.c functions -*- lexical-binding: t -*-
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(ert-deftest overlay-modification-hooks-message-other-buf ()
"Test for bug#21824.
After a modification-hook has been run and there is an overlay in
the *Messages* buffer, the message coalescing [2 times] wrongly
runs the modification-hook of the overlay in the 1st buffer, but
with parameters from the *Messages* buffer modification."
(let ((buf nil)
(msg-ov nil))
(with-temp-buffer
(insert "123")
(overlay-put (make-overlay 1 3)
'modification-hooks
(list (lambda (&rest _)
(setq buf (current-buffer)))))
(goto-char 2)
(insert "x")
(unwind-protect
(progn
(setq msg-ov (make-overlay 1 1 (get-buffer-create "*Messages*")))
(message "a message")
(message "a message")
(should (eq buf (current-buffer))))
(when msg-ov (delete-overlay msg-ov))))))
(ert-deftest overlay-modification-hooks-deleted-overlay ()
"Test for bug#30823."
(let ((check-point nil)
(ov-delete nil)
(ov-set nil))
(with-temp-buffer
(insert "abc")
(setq ov-set (make-overlay 1 3))
(overlay-put ov-set 'modification-hooks
(list (lambda (_o after &rest _args)
(and after (setq check-point t)))))
(setq ov-delete (make-overlay 1 3))
(overlay-put ov-delete 'modification-hooks
(list (lambda (o after &rest _args)
(and (not after) (delete-overlay o)))))
(goto-char 2)
(insert "1")
(should (eq check-point t)))))
(ert-deftest test-generate-new-buffer-name-bug27966 ()
(should-not (string-equal "nil"
(progn (get-buffer-create "nil")
(generate-new-buffer-name "nil")))))
(ert-deftest test-buffer-base-buffer-indirect ()
(with-temp-buffer
(let* ((ind-buf-name (generate-new-buffer-name "indbuf"))
(ind-buf (make-indirect-buffer (current-buffer) ind-buf-name)))
(should (eq (buffer-base-buffer ind-buf) (current-buffer))))))
(ert-deftest test-buffer-base-buffer-non-indirect ()
(with-temp-buffer
(should (eq (buffer-base-buffer (current-buffer)) nil))))
(ert-deftest overlay-evaporation-after-killed-buffer ()
(let* ((ols (with-temp-buffer
(insert "toto")
(list
(make-overlay (point-min) (point-max))
(make-overlay (point-min) (point-max))
(make-overlay (point-min) (point-max)))))
(ol (nth 1 ols)))
(overlay-put ol 'evaporate t)
;; Evaporation within move-overlay of an overlay that was deleted because
;; of a kill-buffer, triggered an assertion failure in unchain_both.
(with-temp-buffer
(insert "toto")
(move-overlay ol (point-min) (point-min)))))
;; +==========================================================================+
;; | Overlay test setup
;; +==========================================================================+
(eval-when-compile
(defun buffer-tests--make-test-name (fn x y)
(intern (format "buffer-tests--%s-%s-%s" fn x y))))
(defun buffer-tests--unmake-test-name (symbol)
(let ((name (if (stringp symbol) symbol (symbol-name symbol))))
(when (string-match "\\`buffer-tests--\\(.*\\)-\\(.*\\)-\\(.*\\)\\'" name)
(list (match-string 1 name)
(match-string 2 name)
(match-string 3 name)))))
(defmacro deftest-make-overlay-1 (id args)
(declare (indent 1))
`(ert-deftest ,(buffer-tests--make-test-name 'make-overlay 1 id) ()
(with-temp-buffer
(should ,(cons 'make-overlay args)))))
(defmacro deftest-make-overlay-2 (id args condition)
(declare (indent 1))
`(ert-deftest ,(buffer-tests--make-test-name 'make-overlay 2 id) ()
(with-temp-buffer
(should-error
,(cons 'make-overlay args)
:type ',condition
:exclude-subtypes t))))
(defmacro deftest-overlay-start/end-1 (id start-end-args start-end-should)
(declare (indent 1))
(cl-destructuring-bind (start end sstart send)
(append start-end-args start-end-should)
`(ert-deftest ,(buffer-tests--make-test-name 'overlay-start/end 1 id) ()
(with-temp-buffer
(insert (make-string 9 ?\n))
(let ((ov (make-overlay ,start ,end)))
(should (equal ,sstart (overlay-start ov)))
(should (equal ,send (overlay-end ov))))))))
(defmacro deftest-overlay-buffer-1 (id arg-expr should-expr)
(declare (indent 1))
`(ert-deftest ,(buffer-tests--make-test-name 'overlay-buffer 1 id) ()
(with-temp-buffer
(should (equal (overlay-buffer (make-overlay 1 1 ,arg-expr))
,should-expr)))))
(defmacro deftest-overlayp-1 (id arg-expr should-expr)
(declare (indent 1))
`(ert-deftest ,(buffer-tests--make-test-name 'overlay-buffer 1 id) ()
(with-temp-buffer
(should (equal ,should-expr (overlayp ,arg-expr))))))
(defmacro deftest-next-overlay-change-1 (id pos result &rest ov-tuple)
`(ert-deftest ,(buffer-tests--make-test-name 'next-overlay-change 1 id) ()
(let ((tuple (copy-sequence ',ov-tuple)))
(with-temp-buffer
(insert (make-string (max 100 (if tuple
(apply #'max
(mapcar
(lambda (m) (apply #'max m))
tuple))
0))
?\n))
(dolist (tup tuple)
(make-overlay (car tup) (cadr tup)))
(should (equal (next-overlay-change ,pos)
,result))))))
(defmacro deftest-previous-overlay-change-1 (id pos result &rest ov-tuple)
`(ert-deftest ,(buffer-tests--make-test-name 'previous-overlay-change 1 id) ()
(let ((tuple ',ov-tuple))
(with-temp-buffer
(insert (make-string (max 100 (if tuple
(apply #'max
(mapcar
(lambda (m) (apply #'max m))
tuple))
0))
?\n))
(dolist (tup tuple)
(make-overlay (car tup) (cadr tup)))
(should (equal (previous-overlay-change ,pos)
,result))))))
(defmacro deftest-overlays-at-1 (id pos result &rest ov-triple)
`(ert-deftest ,(buffer-tests--make-test-name 'overlays-at 1 id) ()
(let ((pos* ,pos))
(with-temp-buffer
(insert (make-string 100 ?\s))
(should-not (memq nil ',result))
(dolist (v ',ov-triple)
(cl-destructuring-bind (tag start end)
v
(overlay-put (make-overlay start end) 'tag tag)))
(let ((ovl (overlays-at pos*)))
(should (equal (length ovl) (length ',result)))
(dolist (ov ovl)
(should (memq (overlay-get ov 'tag) ',result))))))))
(defmacro deftest-overlays-in-1 (id beg end result &rest ov-triple)
`(ert-deftest ,(buffer-tests--make-test-name 'overlays-in 1 id) ()
(let ((beg* ,beg)
(end* ,end))
(with-temp-buffer
(insert (make-string 100 ?\s))
(should-not (memq nil ',result))
(dolist (v ',ov-triple)
(cl-destructuring-bind (tag start end)
v
(overlay-put (make-overlay start end) 'tag tag)))
(let ((ovl (overlays-in beg* end*)))
(should (equal (length ovl) (length ',result)))
(dolist (ov ovl)
(should (memq (overlay-get ov 'tag) ',result))))))))
(defmacro test-with-overlay-in-buffer (symbol-beg-end-fa-ra &rest body)
(declare (indent 1))
(cl-destructuring-bind (symbol beg end &optional fa ra)
symbol-beg-end-fa-ra
`(with-temp-buffer
(insert (make-string (max 1000 (1- ,end)) ?\s))
(goto-char 1)
(let ((,symbol (make-overlay ,beg ,end nil ,fa ,ra)))
,@body))))
(defmacro deftest-overlays-equal-1 (id result ov1-args ov2-args)
`(ert-deftest ,(buffer-tests--make-test-name 'overlays-equal 1 id) ()
(cl-flet ((create-overlay (args)
(cl-destructuring-bind (start end &optional fa ra
&rest properties)
args
(let ((ov (make-overlay start end nil fa ra)))
(while properties
(overlay-put ov (pop properties) (pop properties)))
ov))))
(with-temp-buffer
(insert (make-string 1024 ?\s))
(should (,(if result 'identity 'not)
(equal (create-overlay ',ov1-args)
(create-overlay ',ov2-args))))))))
(defun buffer-tests--find-ert-test (name)
(let ((test (buffer-tests--unmake-test-name name)))
(or (and test
(cl-destructuring-bind (fn x y)
test
(let ((regexp (format "deftest-%s-%s +%s" fn x y)))
(re-search-forward regexp nil t))))
(let ((find-function-regexp-alist
(cl-remove #'buffer-tests--find-ert-test
find-function-regexp-alist :key #'cdr)))
(find-function-do-it name 'ert-deftest
#'switch-to-buffer-other-window)))))
(add-to-list 'find-function-regexp-alist
`(ert-deftest . ,#'buffer-tests--find-ert-test))
;; +==========================================================================+
;; | make-overlay
;; +==========================================================================+
;; Test if making an overlay succeeds.
(deftest-make-overlay-1 A (1 1))
(deftest-make-overlay-1 B (7 26))
(deftest-make-overlay-1 C (29 7))
(deftest-make-overlay-1 D (most-positive-fixnum 1))
(deftest-make-overlay-1 E (most-negative-fixnum 1))
(deftest-make-overlay-1 F (1 most-positive-fixnum))
(deftest-make-overlay-1 G (1 most-negative-fixnum))
(deftest-make-overlay-1 H (1 1 nil t))
(deftest-make-overlay-1 I (1 1 nil nil))
(deftest-make-overlay-1 J (1 1 nil nil nil))
(deftest-make-overlay-1 K (1 1 nil nil t))
(deftest-make-overlay-1 L (1 1 nil t t))
(deftest-make-overlay-1 M (1 1 nil "yes" "yes"))
;; Test if trying to make an overlay signals conditions.
(deftest-make-overlay-2 A () wrong-number-of-arguments)
(deftest-make-overlay-2 B (1) wrong-number-of-arguments)
(deftest-make-overlay-2 C (1 2 3 4 5 6) wrong-number-of-arguments)
(deftest-make-overlay-2 D ("1") wrong-number-of-arguments)
(deftest-make-overlay-2 E ("1" "2") wrong-type-argument)
(deftest-make-overlay-2 F (1 2 "b") wrong-type-argument)
(deftest-make-overlay-2 G (1 2 3.14) wrong-type-argument)
(deftest-make-overlay-2 H (3.14 3) wrong-type-argument)
(deftest-make-overlay-2 I (1 [1]) wrong-type-argument)
(deftest-make-overlay-2 J (1 1 (with-temp-buffer
(current-buffer)))
error)
;; +==========================================================================+
;; | overlay-start/end
;; +==========================================================================+
;; Test if the overlays return proper positions. point-max of the
;; buffer will equal 10. ARG RESULT
(deftest-overlay-start/end-1 A (1 1) (1 1))
(deftest-overlay-start/end-1 B (2 7) (2 7))
(deftest-overlay-start/end-1 C (7 2) (2 7))
(deftest-overlay-start/end-1 D (1 10) (1 10))
(deftest-overlay-start/end-1 E (1 11) (1 10))
(deftest-overlay-start/end-1 F (1 most-positive-fixnum) (1 10))
(deftest-overlay-start/end-1 G (most-positive-fixnum 1) (1 10))
(deftest-overlay-start/end-1 H (most-positive-fixnum most-positive-fixnum)
(10 10))
(deftest-overlay-start/end-1 I (100 11) (10 10))
(deftest-overlay-start/end-1 J (11 100) (10 10))
(deftest-overlay-start/end-1 K (0 1) (1 1))
(deftest-overlay-start/end-1 L (1 0) (1 1))
(deftest-overlay-start/end-1 M (0 0) (1 1))
(ert-deftest test-overlay-start/end-2 ()
(should-not (overlay-start (with-temp-buffer (make-overlay 1 1))))
(should-not (overlay-end (with-temp-buffer (make-overlay 1 1)))))
;; +==========================================================================+
;; | overlay-buffer
;; +==========================================================================+
;; Test if overlay-buffer returns appropriate values.
(deftest-overlay-buffer-1 A (current-buffer) (current-buffer))
(deftest-overlay-buffer-1 B nil (current-buffer))
(ert-deftest test-overlay-buffer-1-C ()
(should-error (make-overlay
1 1 (with-temp-buffer (current-buffer)))))
;; +==========================================================================+
;; | overlayp
;; +==========================================================================+
;; Check the overlay predicate.
(deftest-overlayp-1 A (make-overlay 1 1) t)
(deftest-overlayp-1 B (with-temp-buffer (make-overlay 1 1)) t)
(deftest-overlayp-1 C nil nil)
(deftest-overlayp-1 D 'symbol nil)
(deftest-overlayp-1 E "string" nil)
(deftest-overlayp-1 F 42 nil)
(deftest-overlayp-1 G [1 2] nil)
(deftest-overlayp-1 H (symbol-function 'car) nil)
(deftest-overlayp-1 I float-pi nil)
(deftest-overlayp-1 J (cons 1 2) nil)
(deftest-overlayp-1 K (make-hash-table) nil)
(deftest-overlayp-1 L (symbol-function 'ert-deftest) nil)
(deftest-overlayp-1 M (current-buffer) nil)
(deftest-overlayp-1 N (selected-window) nil)
(deftest-overlayp-1 O (selected-frame) nil)
;; +==========================================================================+
;; | overlay equality
;; +==========================================================================+
(deftest-overlays-equal-1 A t (1 1) (1 1))
(deftest-overlays-equal-1 B t (5 10) (5 10))
(deftest-overlays-equal-1 C nil (5 11) (5 10))
(deftest-overlays-equal-1 D t (10 20 t) (10 20))
(deftest-overlays-equal-1 E t (10 20 nil t) (10 20))
(deftest-overlays-equal-1 F t (10 20 t t) (10 20 nil t))
(deftest-overlays-equal-1 G t (10 20 t t) (10 20 t nil))
(deftest-overlays-equal-1 H t (10 20 nil nil foo 42) (10 20 nil nil foo 42))
(deftest-overlays-equal-1 I nil (10 20 nil nil foo 42) (10 20 nil nil foo 43))
;; +==========================================================================+
;; | overlay-lists
;; +==========================================================================+
;; Check whether overlay-lists returns something sensible.
(ert-deftest test-overlay-lists-1 ()
(with-temp-buffer
(should (equal (cons nil nil) (overlay-lists)))
(dotimes (i 10) (make-overlay 1 i))
(should (listp (car (overlay-lists))))
(should (listp (cdr (overlay-lists))))
(let ((list (append (car (overlay-lists))
(cdr (overlay-lists)))))
(should (= 10 (length list)))
(should (seq-every-p #'overlayp list)))))
;; +==========================================================================+
;; | overlay-put/get/properties
;; +==========================================================================+
;; Test if overlay-put properties can be retrieved by overlay-get and
;; overlay-properties.
(ert-deftest test-overlay-props-1 ()
(with-temp-buffer
(let* ((keys '(:k1 :k2 :k3))
(values '(1 "v2" v3))
(ov (make-overlay 1 1))
(n (length keys)))
(should (equal (length keys) (length values)))
(should (null (overlay-properties ov)))
;; Insert keys and values.
(dotimes (i n)
(should (equal (overlay-put ov (nth i keys) (nth i values))
(nth i values))))
;; Compare with what overlay-get says.
(dotimes (i n)
(should (equal (overlay-get ov (nth i keys))
(nth i values))))
;; Test if overlay-properties is a superset.
(dotimes (i n)
(should (equal (plist-get (overlay-properties ov)
(nth i keys))
(nth i values))))
;; Check if overlay-properties is a subset.
(should (= (length (overlay-properties ov)) (* n 2))))))
;; +==========================================================================+
;; | next-overlay-change
;; +==========================================================================+
;; Test if next-overlay-change returns RESULT if called with POS in a
;; buffer with overlays corresponding to OVS and point-max >= 100.
;; (POS RESULT &rest OVS)
;; 0 overlays
(deftest-next-overlay-change-1 A (point-min) (point-max))
(deftest-next-overlay-change-1 B (point-max) (point-max))
;; 1 non-empty overlay
(deftest-next-overlay-change-1 C 1 10 (10 20))
(deftest-next-overlay-change-1 D 10 20 (10 20))
(deftest-next-overlay-change-1 E 15 20 (10 20))
(deftest-next-overlay-change-1 F 20 (point-max) (10 20))
(deftest-next-overlay-change-1 G 30 (point-max) (10 20))
;; 1 empty overlay
(deftest-next-overlay-change-1 H 1 10 (10 10))
(deftest-next-overlay-change-1 I 10 (point-max) (10 10))
(deftest-next-overlay-change-1 J 20 (point-max) (10 10))
;; 2 non-empty, non-intersecting
(deftest-next-overlay-change-1 D 10 20 (20 30) (40 50))
(deftest-next-overlay-change-1 E 35 40 (20 30) (40 50))
(deftest-next-overlay-change-1 F 60 (point-max) (20 30) (40 50))
(deftest-next-overlay-change-1 G 30 40 (20 30) (40 50))
(deftest-next-overlay-change-1 H 50 (point-max) (20 30) (40 50))
;; 2 non-empty, intersecting
(deftest-next-overlay-change-1 I 10 20 (20 30) (25 35))
(deftest-next-overlay-change-1 J 20 25 (20 30) (25 35))
(deftest-next-overlay-change-1 K 23 25 (20 30) (25 35))
(deftest-next-overlay-change-1 L 25 30 (20 30) (25 35))
(deftest-next-overlay-change-1 M 28 30 (20 30) (25 35))
(deftest-next-overlay-change-1 N 30 35 (20 30) (25 35))
(deftest-next-overlay-change-1 O 35 (point-max) (20 30) (25 35))
(deftest-next-overlay-change-1 P 50 (point-max) (20 30) (25 35))
;; 2 non-empty, continuous
(deftest-next-overlay-change-1 Q 10 20 (20 30) (30 40))
(deftest-next-overlay-change-1 R 20 30 (20 30) (30 40))
(deftest-next-overlay-change-1 S 25 30 (20 30) (30 40))
(deftest-next-overlay-change-1 T 30 40 (20 30) (30 40))
(deftest-next-overlay-change-1 U 35 40 (20 30) (30 40))
(deftest-next-overlay-change-1 V 40 (point-max) (20 30) (30 40))
(deftest-next-overlay-change-1 W 50 (point-max) (20 30) (30 40))
;; 1 empty, 1 non-empty, non-in
(deftest-next-overlay-change-1 a 10 20 (20 20) (30 40))
(deftest-next-overlay-change-1 b 20 30 (20 30) (30 40))
(deftest-next-overlay-change-1 c 25 30 (20 30) (30 40))
(deftest-next-overlay-change-1 d 30 40 (20 30) (30 40))
(deftest-next-overlay-change-1 e 35 40 (20 30) (30 40))
(deftest-next-overlay-change-1 f 40 (point-max) (20 30) (30 40))
(deftest-next-overlay-change-1 g 50 (point-max) (20 30) (30 40))
;; 1 empty, 1 non-empty, intersecting at begin
(deftest-next-overlay-change-1 h 10 20 (20 20) (20 30))
(deftest-next-overlay-change-1 i 20 30 (20 20) (20 30))
(deftest-next-overlay-change-1 j 25 30 (20 20) (20 30))
(deftest-next-overlay-change-1 k 30 (point-max) (20 20) (20 30))
(deftest-next-overlay-change-1 l 40 (point-max) (20 20) (20 30))
;; 1 empty, 1 non-empty, intersecting at end
(deftest-next-overlay-change-1 h 10 20 (30 30) (20 30))
(deftest-next-overlay-change-1 i 20 30 (30 30) (20 30))
(deftest-next-overlay-change-1 j 25 30 (30 30) (20 30))
(deftest-next-overlay-change-1 k 30 (point-max) (20 20) (20 30))
(deftest-next-overlay-change-1 l 40 (point-max) (20 20) (20 30))
;; 1 empty, 1 non-empty, intersecting in the middle
(deftest-next-overlay-change-1 m 10 20 (25 25) (20 30))
(deftest-next-overlay-change-1 n 20 25 (25 25) (20 30))
(deftest-next-overlay-change-1 o 25 30 (25 25) (20 30))
(deftest-next-overlay-change-1 p 30 (point-max) (25 25) (20 30))
(deftest-next-overlay-change-1 q 40 (point-max) (25 25) (20 30))
;; 2 empty, intersecting
(deftest-next-overlay-change-1 r 10 20 (20 20) (20 20))
(deftest-next-overlay-change-1 s 20 (point-max) (20 20) (20 20))
(deftest-next-overlay-change-1 t 30 (point-max) (20 20) (20 20))
;; 2 empty, non-intersecting
(deftest-next-overlay-change-1 u 10 20 (20 20) (30 30))
(deftest-next-overlay-change-1 v 20 30 (20 20) (30 30))
(deftest-next-overlay-change-1 w 25 30 (20 20) (30 30))
(deftest-next-overlay-change-1 x 30 (point-max) (20 20) (30 30))
(deftest-next-overlay-change-1 y 50 (point-max) (20 20) (30 30))
;; 10 random
(deftest-next-overlay-change-1 aa 1 5
(58 66) (41 10) (9 67) (28 88) (27 43)
(24 27) (48 36) (5 90) (61 9))
(deftest-next-overlay-change-1 ab (point-max) (point-max)
(58 66) (41 10) (9 67) (28 88) (27 43)
(24 27) (48 36) (5 90) (61 9))
(deftest-next-overlay-change-1 ac 67 88
(58 66) (41 10) (9 67) (28 88) (27 43)
(24 27) (48 36) (5 90) (61 9))
;; +==========================================================================+
;; | previous-overlay-change.
;; +==========================================================================+
;; Same for previous-overlay-change.
;; 1 non-empty overlay
(deftest-previous-overlay-change-1 A (point-max) 1)
(deftest-previous-overlay-change-1 B 1 1)
(deftest-previous-overlay-change-1 C 1 1 (10 20))
(deftest-previous-overlay-change-1 D 10 1 (10 20))
(deftest-previous-overlay-change-1 E 15 10 (10 20))
(deftest-previous-overlay-change-1 F 20 10 (10 20))
(deftest-previous-overlay-change-1 G 30 20 (10 20))
;; 1 empty overlay
(deftest-previous-overlay-change-1 H 1 1 (10 10))
(deftest-previous-overlay-change-1 I 10 1 (10 10))
(deftest-previous-overlay-change-1 J 20 10 (10 10))
;; 2 non-empty, non-intersecting
(deftest-previous-overlay-change-1 D 10 1 (20 30) (40 50))
(deftest-previous-overlay-change-1 E 35 30 (20 30) (40 50))
(deftest-previous-overlay-change-1 F 60 50 (20 30) (40 50))
(deftest-previous-overlay-change-1 G 30 20 (20 30) (40 50))
(deftest-previous-overlay-change-1 H 50 40 (20 30) (40 50))
;; 2 non-empty, intersecting
(deftest-previous-overlay-change-1 I 10 1 (20 30) (25 35))
(deftest-previous-overlay-change-1 J 20 1 (20 30) (25 35))
(deftest-previous-overlay-change-1 K 23 20 (20 30) (25 35))
(deftest-previous-overlay-change-1 L 25 20 (20 30) (25 35))
(deftest-previous-overlay-change-1 M 28 25 (20 30) (25 35))
(deftest-previous-overlay-change-1 N 30 25 (20 30) (25 35))
(deftest-previous-overlay-change-1 O 35 30 (20 30) (25 35))
(deftest-previous-overlay-change-1 P 50 35 (20 30) (25 35))
;; 2 non-empty, continuous
(deftest-previous-overlay-change-1 Q 10 1 (20 30) (30 40))
(deftest-previous-overlay-change-1 R 20 1 (20 30) (30 40))
(deftest-previous-overlay-change-1 S 25 20 (20 30) (30 40))
(deftest-previous-overlay-change-1 T 30 20 (20 30) (30 40))
(deftest-previous-overlay-change-1 U 35 30 (20 30) (30 40))
(deftest-previous-overlay-change-1 V 40 30 (20 30) (30 40))
(deftest-previous-overlay-change-1 W 50 40 (20 30) (30 40))
;; 1 empty, 1 non-empty, non-intersecting
(deftest-previous-overlay-change-1 a 10 1 (20 20) (30 40))
(deftest-previous-overlay-change-1 b 20 1 (20 30) (30 40))
(deftest-previous-overlay-change-1 c 25 20 (20 30) (30 40))
(deftest-previous-overlay-change-1 d 30 20 (20 30) (30 40))
(deftest-previous-overlay-change-1 e 35 30 (20 30) (30 40))
(deftest-previous-overlay-change-1 f 40 30 (20 30) (30 40))
(deftest-previous-overlay-change-1 g 50 40 (20 30) (30 40))
;; 1 empty, 1 non-empty, intersecting at begin
(deftest-previous-overlay-change-1 h 10 1 (20 20) (20 30))
(deftest-previous-overlay-change-1 i 20 1 (20 20) (20 30))
(deftest-previous-overlay-change-1 j 25 20 (20 20) (20 30))
(deftest-previous-overlay-change-1 k 30 20 (20 20) (20 30))
(deftest-previous-overlay-change-1 l 40 30 (20 20) (20 30))
;; 1 empty, 1 non-empty, intersecting at end
(deftest-previous-overlay-change-1 m 10 1 (30 30) (20 30))
(deftest-previous-overlay-change-1 n 20 1 (30 30) (20 30))
(deftest-previous-overlay-change-1 o 25 20 (30 30) (20 30))
(deftest-previous-overlay-change-1 p 30 20 (20 20) (20 30))
(deftest-previous-overlay-change-1 q 40 30 (20 20) (20 30))
;; 1 empty, 1 non-empty, intersecting in the middle
(deftest-previous-overlay-change-1 r 10 1 (25 25) (20 30))
(deftest-previous-overlay-change-1 s 20 1 (25 25) (20 30))
(deftest-previous-overlay-change-1 t 25 20 (25 25) (20 30))
(deftest-previous-overlay-change-1 u 30 25 (25 25) (20 30))
(deftest-previous-overlay-change-1 v 40 30 (25 25) (20 30))
;; 2 empty, intersecting
(deftest-previous-overlay-change-1 w 10 1 (20 20) (20 20))
(deftest-previous-overlay-change-1 x 20 1 (20 20) (20 20))
(deftest-previous-overlay-change-1 y 30 20 (20 20) (20 20))
;; 2 empty, non-intersecting
(deftest-previous-overlay-change-1 z 10 1 (20 20) (30 30))
(deftest-previous-overlay-change-1 aa 20 1 (20 20) (30 30))
(deftest-previous-overlay-change-1 ab 25 20 (20 20) (30 30))
(deftest-previous-overlay-change-1 ac 30 20 (20 20) (30 30))
(deftest-previous-overlay-change-1 ad 50 30 (20 20) (30 30))
;; 10 random
(deftest-previous-overlay-change-1 ae 100 90
(58 66) (41 10) (9 67) (28 88) (27 43)
(24 27) (48 36) (5 90) (61 9))
(deftest-previous-overlay-change-1 af (point-min) (point-min)
(58 66) (41 10) (9 67) (28 88) (27 43)
(24 27) (48 36) (5 90) (61 9))
(deftest-previous-overlay-change-1 ag 29 28
(58 66) (41 10) (9 67) (28 88) (27 43)
(24 27) (48 36) (5 90) (61 9))
;; +==========================================================================+
;; | overlays-at
;; +==========================================================================+
;; Test whether overlay-at returns RESULT at POS after overlays OVL were
;; created in a buffer. POS RES OVL
(deftest-overlays-at-1 A 1 ())
;; 1 overlay
(deftest-overlays-at-1 B 10 (a) (a 10 20))
(deftest-overlays-at-1 C 15 (a) (a 10 20))
(deftest-overlays-at-1 D 19 (a) (a 10 20))
(deftest-overlays-at-1 E 20 () (a 10 20))
(deftest-overlays-at-1 F 1 () (a 10 20))
;; 2 non-empty overlays non-intersecting
(deftest-overlays-at-1 G 1 () (a 10 20) (b 30 40))
(deftest-overlays-at-1 H 10 (a) (a 10 20) (b 30 40))
(deftest-overlays-at-1 I 15 (a) (a 10 20) (b 30 40))
(deftest-overlays-at-1 K 20 () (a 10 20) (b 30 40))
(deftest-overlays-at-1 L 25 () (a 10 20) (b 30 40))
(deftest-overlays-at-1 M 30 (b) (a 10 20) (b 30 40))
(deftest-overlays-at-1 N 35 (b) (a 10 20) (b 30 40))
(deftest-overlays-at-1 O 40 () (a 10 20) (b 30 40))
(deftest-overlays-at-1 P 50 () (a 10 20) (b 30 40))
;; 2 non-empty overlays intersecting
(deftest-overlays-at-1 G 1 () (a 10 30) (b 20 40))
(deftest-overlays-at-1 H 10 (a) (a 10 30) (b 20 40))
(deftest-overlays-at-1 I 15 (a) (a 10 30) (b 20 40))
(deftest-overlays-at-1 K 20 (a b) (a 10 30) (b 20 40))
(deftest-overlays-at-1 L 25 (a b) (a 10 30) (b 20 40))
(deftest-overlays-at-1 M 30 (b) (a 10 30) (b 20 40))
(deftest-overlays-at-1 N 35 (b) (a 10 30) (b 20 40))
(deftest-overlays-at-1 O 40 () (a 10 30) (b 20 40))
(deftest-overlays-at-1 P 50 () (a 10 30) (b 20 40))
;; 2 non-empty overlays continuous
(deftest-overlays-at-1 G 1 () (a 10 20) (b 20 30))
(deftest-overlays-at-1 H 10 (a) (a 10 20) (b 20 30))
(deftest-overlays-at-1 I 15 (a) (a 10 20) (b 20 30))
(deftest-overlays-at-1 K 20 (b) (a 10 20) (b 20 30))
(deftest-overlays-at-1 L 25 (b) (a 10 20) (b 20 30))
(deftest-overlays-at-1 M 30 () (a 10 20) (b 20 30))
;; overlays-at never returns empty overlays.
(deftest-overlays-at-1 N 1 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
(deftest-overlays-at-1 O 20 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
(deftest-overlays-at-1 P 30 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
(deftest-overlays-at-1 Q 40 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
(deftest-overlays-at-1 R 50 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
(deftest-overlays-at-1 S 60 () (a 1 60) (c 1 1) (b 30 30) (d 50 50))
;; behavior at point-min and point-max
(ert-deftest test-overlays-at-2 ()
(cl-macrolet ((should-length (n list)
`(should (= ,n (length ,list)))))
(with-temp-buffer
(insert (make-string 100 ?\s))
(make-overlay 1 (point-max))
(make-overlay 10 10)
(make-overlay 20 20)
(make-overlay (point-max) (point-max))
(should-length 1 (overlays-at 1))
(should-length 1 (overlays-at 10))
(should-length 1 (overlays-at 20))
(should-length 0 (overlays-at (point-max)))
(narrow-to-region 10 20)
(should-length 1 (overlays-at (point-min)))
(should-length 1 (overlays-at 15))
(should-length 1 (overlays-at (point-max))))))
;; +==========================================================================+
;; | overlay-in
;; +==========================================================================+
;; Test whether overlays-in returns RES in BEG,END after overlays OVL were
;; created in a buffer.
(deftest-overlays-in-1 A 1 (point-max) ());;POS RES OVL
;; 1 overlay
(deftest-overlays-in-1 B 1 10 () (a 10 20))
(deftest-overlays-in-1 C 5 10 () (a 10 20))
(deftest-overlays-in-1 D 5 15 (a) (a 10 20))
(deftest-overlays-in-1 E 10 15 (a) (a 10 20))
(deftest-overlays-in-1 F 10 20 (a) (a 10 20))
(deftest-overlays-in-1 G 15 20 (a) (a 10 20))
(deftest-overlays-in-1 H 15 25 (a) (a 10 20))
(deftest-overlays-in-1 I 20 25 () (a 10 20))
(deftest-overlays-in-1 J 30 50 () (a 10 20))
;; 2 non-empty overlays non-intersecting
(deftest-overlays-in-1 K 1 5 () (a 10 20) (b 30 40))
(deftest-overlays-in-1 L 5 10 () (a 10 20) (b 30 40))
(deftest-overlays-in-1 M 5 15 (a) (a 10 20) (b 30 40))
(deftest-overlays-in-1 N 10 15 (a) (a 10 20) (b 30 40))
(deftest-overlays-in-1 O 15 20 (a) (a 10 20) (b 30 40))
(deftest-overlays-in-1 P 15 25 (a) (a 10 20) (b 30 40))
(deftest-overlays-in-1 Q 20 25 () (a 10 20) (b 30 40))
(deftest-overlays-in-1 R 20 30 () (a 10 20) (b 30 40))
(deftest-overlays-in-1 S 25 30 () (a 10 20) (b 30 40))
(deftest-overlays-in-1 T 25 35 (b) (a 10 20) (b 30 40))
(deftest-overlays-in-1 U 30 35 (b) (a 10 20) (b 30 40))
(deftest-overlays-in-1 V 40 50 () (a 10 20) (b 30 40))
(deftest-overlays-in-1 W 50 60 () (a 10 20) (b 30 40))
(deftest-overlays-in-1 X 1 50 (a b) (a 10 20) (b 30 40))
(deftest-overlays-in-1 Y 10 40 (a b) (a 10 20) (b 30 40))
(deftest-overlays-in-1 Z 10 41 (a b) (a 10 20) (b 30 40))
;; 2 non-empty overlays intersecting
(deftest-overlays-in-1 a 1 5 () (a 10 30) (b 20 40))
(deftest-overlays-in-1 b 5 10 () (a 10 30) (b 20 40))
(deftest-overlays-in-1 c 5 15 (a) (a 10 30) (b 20 40))
(deftest-overlays-in-1 d 10 15 (a) (a 10 30) (b 20 40))
(deftest-overlays-in-1 e 10 20 (a) (a 10 30) (b 20 40))
(deftest-overlays-in-1 f 15 20 (a) (a 10 30) (b 20 40))
(deftest-overlays-in-1 g 20 30 (a b) (a 10 30) (b 20 40))
(deftest-overlays-in-1 h 20 40 (a b) (a 10 30) (b 20 40))
(deftest-overlays-in-1 i 25 30 (a b) (a 10 30) (b 20 40))
(deftest-overlays-in-1 j 30 30 (b) (a 10 30) (b 20 40))
(deftest-overlays-in-1 k 30 35 (b) (a 10 30) (b 20 40))
(deftest-overlays-in-1 l 35 40 (b) (a 10 30) (b 20 40))
(deftest-overlays-in-1 m 40 45 () (a 10 30) (b 20 40))
(deftest-overlays-in-1 n 41 45 () (a 10 30) (b 20 40))
(deftest-overlays-in-1 o 50 60 () (a 10 30) (b 20 40))
;; 2 non-empty overlays continuous
(deftest-overlays-in-1 p 1 5 () (a 10 20) (b 20 30))
(deftest-overlays-in-1 q 5 10 () (a 10 20) (b 20 30))
(deftest-overlays-in-1 r 15 20 (a) (a 10 20) (b 20 30))
(deftest-overlays-in-1 s 15 25 (a b) (a 10 20) (b 20 30))
(deftest-overlays-in-1 t 20 25 (b) (a 10 20) (b 20 30))
(deftest-overlays-in-1 u 25 30 (b) (a 10 20) (b 20 30))
(deftest-overlays-in-1 v 29 35 (b) (a 10 20) (b 20 30))
(deftest-overlays-in-1 w 30 35 () (a 10 20) (b 20 30))
(deftest-overlays-in-1 x 35 50 () (a 10 20) (b 20 30))
(deftest-overlays-in-1 y 1 50 (a b) (a 10 20) (b 20 30))
(deftest-overlays-in-1 z 15 50 (a b) (a 10 20) (b 20 30))
(deftest-overlays-in-1 aa 1 25 (a b) (a 10 20) (b 20 30))
;; 1 empty overlay
(deftest-overlays-in-1 ab 1 10 () (a 10 10))
(deftest-overlays-in-1 ac 10 10 (a) (a 10 10))
(deftest-overlays-in-1 ad 9 10 () (a 10 10))
(deftest-overlays-in-1 ae 9 11 (a) (a 10 10))
(deftest-overlays-in-1 af 10 11 (a) (a 10 10))
;; behavior at point-max
(ert-deftest test-overlays-in-2 ()
(cl-macrolet ((should-length (n list)
`(should (= ,n (length ,list)))))
(with-temp-buffer
(insert (make-string 100 ?\s))
(make-overlay (point-max) (point-max))
(make-overlay 50 50)
(should-length 1 (overlays-in 50 50))
(should-length 2 (overlays-in 1 (point-max)))
(should-length 1 (overlays-in (point-max) (point-max)))
(narrow-to-region 1 50)
(should-length 0 (overlays-in 1 (point-max)))
(should-length 1 (overlays-in (point-max) (point-max))))))
;; +==========================================================================+
;; | overlay-recenter
;; +==========================================================================+
;; This function is a noop in the overlay tree branch.
(ert-deftest test-overlay-recenter ()
(with-temp-buffer
(should-not (overlay-recenter 1))
(insert (make-string 100 ?\s))
(dotimes (i 10)
(make-overlay i (1+ i))
(should-not (overlay-recenter i)))))
;; +==========================================================================+
;; | move-overlay
;; +==========================================================================+
;; buffer nil with live overlay
(ert-deftest test-move-overlay-1 ()
(test-with-overlay-in-buffer (ov 1 100)
(move-overlay ov 50 60)
(should (= 50 (overlay-start ov)))
(should (= 60 (overlay-end ov)))
(should (eq (current-buffer) (overlay-buffer ov)))))
;; buffer nil, dead overlay
(ert-deftest test-move-overlay-2 ()
(with-temp-buffer
(let ((ov (test-with-overlay-in-buffer (ov 1 100) ov)))
(insert (make-string 100 ?\s))
(move-overlay ov 50 60)
(should (= 50 (overlay-start ov)))
(should (= 60 (overlay-end ov)))
(should (eq (current-buffer) (overlay-buffer ov))))))
;; buffer non-nil, live overlay
(ert-deftest test-move-overlay-3 ()
(test-with-overlay-in-buffer (ov 10 100)
(with-temp-buffer
(move-overlay ov 1 1 (current-buffer))
(should (= 1 (overlay-start ov)))
(should (= 1 (overlay-end ov)))
(should (eq (current-buffer) (overlay-buffer ov))))
(should-not (overlay-start ov))
(should-not (overlay-end ov))
(should-not (overlay-buffer ov))))
;; buffer non-nil, dead overlay
(ert-deftest test-move-overlay-4 ()
(let ((ov (test-with-overlay-in-buffer (ov 1 1) ov)))
(with-temp-buffer
(move-overlay ov 1 1 (current-buffer))
(should (= 1 (overlay-start ov)))
(should (= 1 (overlay-end ov)))
(should (eq (current-buffer) (overlay-buffer ov))))
(should-not (overlay-start ov))
(should-not (overlay-end ov))
(should-not (overlay-buffer ov))))
;; +==========================================================================+
;; | delete-(all-)overlay
;; +==========================================================================+
;; delete live overlay
(ert-deftest test-delete-overlay-1 ()
(test-with-overlay-in-buffer (ov 10 100)
(should (buffer-live-p (overlay-buffer ov)))
(delete-overlay ov)
(should-not (overlay-start ov))
(should-not (overlay-end ov))
(should-not (overlay-buffer ov))))
;; delete dead overlay
(ert-deftest test-delete-overlay-2 ()
(let ((ov (test-with-overlay-in-buffer (ov 10 100) ov)))
(should-not (overlay-start ov))
(should-not (overlay-end ov))
(should-not (overlay-buffer ov))
(should-not (delete-overlay ov))
(should-not (overlay-start ov))
(should-not (overlay-end ov))
(should-not (overlay-buffer ov))))
(ert-deftest test-delete-all-overlay-1 ()
(with-temp-buffer
(should-not (delete-all-overlays))
(should-not (delete-all-overlays (current-buffer)))
(insert (make-string 100 ?\s))
(dotimes (i 10) (make-overlay i (1+ i)))
(should-not (delete-all-overlays (current-buffer)))
(should-not (delete-all-overlays))))
;; +==========================================================================+
;; | get-char-property(-and-overlay)
;; +==========================================================================+
;; FIXME: TBD
;; +==========================================================================+
;; | Moving by insertions
;; +==========================================================================+
(defmacro deftest-moving-insert-1 (id beg-end insert sbeg-send fa ra)
(cl-destructuring-bind (beg end ipos ilen sbeg send fa ra)
(append beg-end insert sbeg-send (list fa ra) nil)
`(ert-deftest ,(buffer-tests--make-test-name 'moving-insert 1 id) ()
(test-with-overlay-in-buffer (ov ,beg ,end ,fa ,ra)
(should (= ,beg (overlay-start ov)))
(should (= ,end (overlay-end ov)))
(goto-char ,ipos)
(insert (make-string ,ilen ?x))
(should (= ,sbeg (overlay-start ov)))
(should (= ,send (overlay-end ov)))))))
;; non-empty, no fa, no ra
;; -------------------- OV INS RESULT
(deftest-moving-insert-1 A (10 20) (15 3) (10 23) nil nil)
(deftest-moving-insert-1 B (10 20) (20 4) (10 20) nil nil)
(deftest-moving-insert-1 C (10 20) (5 5) (15 25) nil nil)
(deftest-moving-insert-1 D (10 20) (10 3) (10 23) nil nil)
(deftest-moving-insert-1 E (10 20) (20 4) (10 20) nil nil)
;; non-empty no fa, ra
(deftest-moving-insert-1 F (10 20) (15 3) (10 23) nil t)
(deftest-moving-insert-1 G (10 20) (20 4) (10 24) nil t)
(deftest-moving-insert-1 H (10 20) (5 5) (15 25) nil t)
(deftest-moving-insert-1 I (10 20) (10 3) (10 23) nil t)
(deftest-moving-insert-1 J (10 20) (20 4) (10 24) nil t)
;; non-empty, fa, no r
(deftest-moving-insert-1 K (10 20) (15 3) (10 23) t nil)
(deftest-moving-insert-1 L (10 20) (20 4) (10 20) t nil)
(deftest-moving-insert-1 M (10 20) (5 5) (15 25) t nil)
(deftest-moving-insert-1 N (10 20) (10 3) (13 23) t nil)
(deftest-moving-insert-1 O (10 20) (20 4) (10 20) t nil)
;; This used to fail.
(ert-deftest test-moving-insert-2-a ()
(with-temp-buffer
(insert (make-string 1 ?.))
(let ((ov (make-overlay 1 1 nil t nil)))
(insert "()")
(should (= 1 (overlay-end ov))))))
;; non-empty, fa, ra
(deftest-moving-insert-1 P (10 20) (15 3) (10 23) t t)
(deftest-moving-insert-1 Q (10 20) (20 4) (10 24) t t)
(deftest-moving-insert-1 R (10 20) (5 5) (15 25) t t)
(deftest-moving-insert-1 S (10 20) (10 3) (13 23) t t)
(deftest-moving-insert-1 T (10 20) (20 4) (10 24) t t)
;; empty, no fa, no ra
(deftest-moving-insert-1 U (15 15) (20 4) (15 15) nil nil)
(deftest-moving-insert-1 V (15 15) (5 5) (20 20) nil nil)
(deftest-moving-insert-1 W (15 15) (15 3) (15 15) nil nil)
;; empty no fa, ra
(deftest-moving-insert-1 X (15 15) (20 4) (15 15) nil t)
(deftest-moving-insert-1 Y (15 15) (5 5) (20 20) nil t)
(deftest-moving-insert-1 Z (15 15) (15 3) (15 18) nil t)
;; empty, fa, no ra
(deftest-moving-insert-1 a (15 15) (20 4) (15 15) t nil)
(deftest-moving-insert-1 b (15 15) (5 5) (20 20) t nil)
(deftest-moving-insert-1 c (15 15) (15 3) (15 15) t nil)
;; empty, fa, ra
(deftest-moving-insert-1 d (15 15) (20 4) (15 15) t t)
(deftest-moving-insert-1 e (15 15) (5 5) (20 20) t t)
(deftest-moving-insert-1 f (15 15) (15 3) (18 18) t t)
;; Try to trigger a pathological case where the tree could become
;; unordered due to an insert operation.
(ert-deftest test-moving-insert-2 ()
(with-temp-buffer
(insert (make-string 1000 ?x))
(let ((root (make-overlay 50 75 nil nil 'rear-advance))
(left (make-overlay 25 50 nil 'front-advance 'rear-advance))
(right (make-overlay 75 100 nil nil nil)))
;; [50] <--- start
;; / \
;; (25) (75)
(delete-region 25 75)
;; [25]
;; / \
;; (25) (25)
(should (= 25 (overlay-start root)))
(should (= 25 (overlay-end root)))
(should (= 25 (overlay-start left)))
(should (= 25 (overlay-end left)))
(should (= 25 (overlay-start right)))
(should (= 50 (overlay-end right)))
;; Inserting at start should make left advance while right and
;; root stay, thus we would have left > right .
(goto-char 25)
(insert (make-string 25 ?x))
;; [25]
;; / \
;; (50) (25)
(should (= 25 (overlay-start root)))
(should (= 50 (overlay-end root)))
(should (= 50 (overlay-start left)))
(should (= 50 (overlay-end left)))
(should (= 25 (overlay-start right)))
(should (= 75 (overlay-end right)))
;; Try to detect the error, by removing left. The should fail
;; an eassert, since it won't be found by a regular tree
;; traversal - in theory.
(delete-overlay left)
(should (= 2 (length (overlays-in 1 (point-max))))))))
;; +==========================================================================+
;; | Moving by deletions
;; +==========================================================================+
(defmacro deftest-moving-delete-1 (id beg-end delete sbeg-send fa ra)
(cl-destructuring-bind (beg end dpos dlen sbeg send fa ra)
(append beg-end delete sbeg-send (list fa ra) nil)
`(ert-deftest ,(buffer-tests--make-test-name 'moving-delete 1 id) ()
(test-with-overlay-in-buffer (ov ,beg ,end ,fa ,ra)
(should (= ,beg (overlay-start ov)))
(should (= ,end (overlay-end ov)))
(delete-region ,dpos (+ ,dpos ,dlen))
(should (= ,sbeg (overlay-start ov)))
(should (= ,send (overlay-end ov)))))))
;; non-empty, no fa, no ra
;; -------------------- OV DEL RESULT
(deftest-moving-delete-1 A (10 20) (15 3) (10 17) nil nil)
(deftest-moving-delete-1 B (10 20) (20 4) (10 20) nil nil)
(deftest-moving-delete-1 C (10 20) (5 5) (5 15) nil nil)
(deftest-moving-delete-1 D (10 20) (10 3) (10 17) nil nil)
(deftest-moving-delete-1 E (10 20) (20 4) (10 20) nil nil)
;; non-empty no fa, ra
(deftest-moving-delete-1 F (10 20) (15 3) (10 17) nil t)
(deftest-moving-delete-1 G (10 20) (20 4) (10 20) nil t)
(deftest-moving-delete-1 H (10 20) (5 5) (5 15) nil t)
(deftest-moving-delete-1 I (10 20) (10 3) (10 17) nil t)
(deftest-moving-delete-1 J (10 20) (20 4) (10 20) nil t)
;; non-empty, fa, no ra
(deftest-moving-delete-1 K (10 20) (15 3) (10 17) t nil)
(deftest-moving-delete-1 L (10 20) (20 4) (10 20) t nil)
(deftest-moving-delete-1 M (10 20) (5 5) (5 15) t nil)
(deftest-moving-delete-1 N (10 20) (10 3) (10 17) t nil)
(deftest-moving-delete-1 O (10 20) (20 4) (10 20) t nil)
;; non-empty, fa, ra
(deftest-moving-delete-1 P (10 20) (15 3) (10 17) t t)
(deftest-moving-delete-1 Q (10 20) (20 4) (10 20) t t)
(deftest-moving-delete-1 R (10 20) (5 5) (5 15) t t)
(deftest-moving-delete-1 S (10 20) (10 3) (10 17) t t)
(deftest-moving-delete-1 T (10 20) (20 4) (10 20) t t)
;; empty, no fa, no ra
(deftest-moving-delete-1 U (15 15) (20 4) (15 15) nil nil)
(deftest-moving-delete-1 V (15 15) (5 5) (10 10) nil nil)
(deftest-moving-delete-1 W (15 15) (15 3) (15 15) nil nil)
;; empty no fa, ra
(deftest-moving-delete-1 X (15 15) (20 4) (15 15) nil t)
(deftest-moving-delete-1 Y (15 15) (5 5) (10 10) nil t)
(deftest-moving-delete-1 Z (15 15) (15 3) (15 15) nil t)
;; empty, fa, no ra
(deftest-moving-delete-1 a (15 15) (20 4) (15 15) t nil)
(deftest-moving-delete-1 b (15 15) (5 5) (10 10) t nil)
(deftest-moving-delete-1 c (15 15) (15 3) (15 15) t nil)
;; empty, fa, ra
(deftest-moving-delete-1 d (15 15) (20 4) (15 15) t t)
(deftest-moving-delete-1 e (15 15) (5 5) (10 10) t t)
(deftest-moving-delete-1 f (15 15) (15 3) (15 15) t t)
;; +==========================================================================+
;; | make-indirect-buffer
;; +==========================================================================+
;; Check if overlays are cloned/separate from indirect buffer.
(ert-deftest test-make-indirect-buffer-1 ()
(with-temp-buffer
(dotimes (_ 10) (make-overlay 1 1))
(let (indirect clone)
(unwind-protect
(progn
(setq indirect (make-indirect-buffer
(current-buffer) "indirect"))
(with-current-buffer indirect
(should-not (overlays-in (point-min) (point-max)))
(dotimes (_ 20) (make-overlay 1 1))
(should (= 20 (length (overlays-in (point-min) (point-max)))))
(delete-all-overlays)
(should-not (overlays-in (point-min) (point-max))))
(should (= 10 (length (overlays-in (point-min) (point-max)))))
(setq clone (make-indirect-buffer
(current-buffer) "clone" 'clone))
(with-current-buffer clone
(should (= 10 (length (overlays-in (point-min) (point-max)))))
(dotimes (_ 30) (make-overlay 1 1))
(should (= 40 (length (overlays-in (point-min) (point-max))))))
;; back in temp buffer
(should (= 10 (length (overlays-in (point-min) (point-max)))))
(with-current-buffer clone
(mapc #'delete-overlay
(seq-take (overlays-in (point-min) (point-max)) 10))
(should (= 30 (length (overlays-in (point-min) (point-max))))))
(should (= 10 (length (overlays-in (point-min) (point-max)))))
(delete-all-overlays)
(with-current-buffer clone
(should (= 30 (length (overlays-in (point-min) (point-max)))))))
(when (buffer-live-p clone)
(kill-buffer clone))
(when (buffer-live-p indirect)
(kill-buffer indirect))))))
;; +==========================================================================+
;; | buffer-swap-text
;; +==========================================================================+
(defmacro buffer-tests--with-temp-buffers (vars &rest body)
(declare (indent 1) (debug (sexp &rest form)))
(if (null vars)
`(progn ,@body)
`(with-temp-buffer
(let ((,(car vars) (current-buffer)))
(buffer-tests--with-temp-buffers ,(cdr vars) ,@body)))))
;; basic
(ert-deftest test-buffer-swap-text-1 ()
(buffer-tests--with-temp-buffers (buffer other)
(with-current-buffer buffer
(let ((ov (make-overlay 1 1)))
(buffer-swap-text other)
(should-not (overlays-in 1 1))
(with-current-buffer other
(should (overlays-in 1 1))
(should (eq ov (car (overlays-in 1 1)))))))))
;; properties
(ert-deftest test-buffer-swap-text-1 ()
(buffer-tests--with-temp-buffers (buffer other)
(with-current-buffer other
(overlay-put (make-overlay 1 1) 'buffer 'other))
(with-current-buffer buffer
(overlay-put (make-overlay 1 1) 'buffer 'buffer)
(buffer-swap-text other)
(should (= 1 (length (overlays-in 1 1))))
(should (eq (overlay-get (car (overlays-in 1 1)) 'buffer) 'other)))
(with-current-buffer other
(should (= 1 (length (overlays-in 1 1))))
(should (eq (overlay-get (car (overlays-in 1 1)) 'buffer) 'buffer)))))
;; +==========================================================================+
;; | priorities
;; +==========================================================================+
(ert-deftest test-overlay-priorities-1 ()
(with-temp-buffer
(insert " ")
(dotimes (i 10)
(let ((ov (make-overlay 1 2)))
(overlay-put ov 'priority i)
(overlay-put ov 'value i)))
(should (eq 9 (get-char-property 1 'value)))))
(ert-deftest test-overlay-priorities-2 ()
(with-temp-buffer
(insert " ")
(dotimes (j 10)
(let* ((i (- 9 j))
(ov (make-overlay 1 2)))
(overlay-put ov 'priority i)
(overlay-put ov 'value i)))
(should (eq 9 (get-char-property 1 'value)))))
;; +==========================================================================+
;; | Other
;; +==========================================================================+
(defun test-overlay-regions ()
(sort (mapcar (lambda (ov)
(cons (overlay-start ov)
(overlay-end ov)))
(overlays-in (point-min)
(point-max)))
(lambda (o1 o2)
(or (< (car o1) (car o2))
(and (= (car o1) (car o2))
(< (cdr o1) (cdr o2)))))))
;; This test used to fail.
(ert-deftest overlay-complex-delete-with-offset ()
(with-temp-buffer
(let (todelete)
(insert (make-string 1000 ?\s))
(make-overlay 1 2 nil t nil)
(make-overlay 2 3 nil t nil)
(make-overlay 3 4 nil t nil)
(make-overlay 4 5 nil t nil)
(setq todelete (make-overlay 280 287 nil t nil))
(make-overlay 265 275 nil t nil)
(make-overlay 329 386 nil t nil)
(make-overlay 386 390 nil t nil)
(goto-char 50)
(delete-char 50)
(goto-char 1)
(delete-char 2)
(delete-overlay todelete)
(should (equal (test-overlay-regions)
'((1 . 1) (1 . 1) (1 . 2) (2 . 3) (213 . 223) (277 . 334) (334 . 338)))))))
;; This test used to fail.
(ert-deftest overlay-complex-insert-1 ()
(with-temp-buffer
(insert " ")
(make-overlay 8 11 nil nil t)
(make-overlay 2 7 nil nil nil)
(make-overlay 2 4 nil t nil)
(goto-char 1)
(insert " ")
(should (equal (test-overlay-regions)
'((7 . 9)
(7 . 12)
(13 . 16))))))
;; This test used to fail.
(ert-deftest overlay-complex-insert-2 ()
(with-temp-buffer
(insert (make-string 100 ?\s))
(make-overlay 77 7 nil nil t)
(make-overlay 21 53 nil t t)
(make-overlay 84 14 nil nil nil)
(make-overlay 38 69 nil t nil)
(make-overlay 93 15 nil nil t)
(make-overlay 73 48 nil t t)
(make-overlay 96 51 nil t t)
(make-overlay 6 43 nil t t)
(make-overlay 15 100 nil t t)
(make-overlay 22 17 nil nil nil)
(make-overlay 72 45 nil t nil)
(make-overlay 2 74 nil nil t)
(make-overlay 15 29 nil t t)
(make-overlay 17 34 nil t t)
(make-overlay 101 66 nil t nil)
(make-overlay 94 24 nil nil nil)
(goto-char 78)
(insert " ")
(narrow-to-region 47 19)
(goto-char 46)
(widen)
(narrow-to-region 13 3)
(goto-char 9)
(delete-char 0)
(goto-char 11)
(insert " ")
(goto-char 3)
(insert " ")
(goto-char 8)
(insert " ")
(goto-char 26)
(insert " ")
(goto-char 14)
(widen)
(narrow-to-region 71 35)
(should
(equal (test-overlay-regions)
'((2 . 104)
(23 . 73)
(24 . 107)
(44 . 125)
(45 . 59)
(45 . 134)
(45 . 141)
(47 . 52)
(47 . 64)
(51 . 83)
(54 . 135)
(68 . 99))))))
(ert-deftest test-overlay-multibyte-transition-1 ()
(with-temp-buffer
(set-buffer-multibyte t)
(insert "ääää")
;; aeaeaeae
;; 1 2 3 4 5
;; 123456789
(let ((nonempty-bob (make-overlay 1 2))
(empty-bob (make-overlay 1 1))
(empty (make-overlay 2 2))
(nonempty (make-overlay 2 4))
(nonempty-eob (make-overlay 4 5))
(empty-eob (make-overlay 5 5)))
(set-buffer-multibyte nil)
(cl-macrolet
((ovshould (ov begin end)
`(should (equal (list (overlay-start ,ov) (overlay-end ,ov))
(list ,begin ,end)))))
(ovshould nonempty-bob 1 3)
(ovshould empty-bob 1 1)
(ovshould empty 3 3)
(ovshould nonempty 3 7)
(ovshould nonempty-eob 7 9)
(ovshould empty-eob 9 9)))))
(ert-deftest test-overlay-multibyte-transition-2 ()
(with-temp-buffer
(set-buffer-multibyte t)
(insert "ääää")
(set-buffer-multibyte nil)
;; aeaeaeae
;; 1 2 3 4 5
;; 123456789
(let ((nonempty-bob-end (make-overlay 1 2))
(nonempty-bob-beg (make-overlay 1 3))
(empty-bob (make-overlay 1 1))
(empty-beg (make-overlay 3 3))
(empty-end (make-overlay 2 2))
(nonempty-beg-beg (make-overlay 3 7))
(nonempty-beg-end (make-overlay 3 8))
(nonempty-end-beg (make-overlay 4 7))
(nonempty-end-end (make-overlay 4 8))
(nonempty-eob-beg (make-overlay 5 9))
(nonempty-eob-end (make-overlay 6 9))
(empty-eob (make-overlay 9 9)))
(set-buffer-multibyte t)
(cl-macrolet
((ovshould (ov begin end)
`(should (equal (list (overlay-start ,ov) (overlay-end ,ov))
(list ,begin ,end)))))
(ovshould nonempty-bob-end 1 2)
(ovshould nonempty-bob-beg 1 2)
(ovshould empty-bob 1 1)
(ovshould empty-beg 2 2)
(ovshould empty-end 2 2)
(ovshould nonempty-beg-beg 2 4)
(ovshould nonempty-beg-end 2 5)
(ovshould nonempty-end-beg 3 4)
(ovshould nonempty-end-end 3 5)
(ovshould nonempty-eob-beg 3 5)
(ovshould nonempty-eob-end 4 5)
(ovshould empty-eob 5 5)))))
(ert-deftest buffer-multibyte-overlong-sequences ()
(dolist (uni '("\xE0\x80\x80"
"\xF0\x80\x80\x80"
"\xF8\x8F\xBF\xBF\x80"))
(let ((multi (string-to-multibyte uni)))
(should
(string-equal
multi
(with-temp-buffer
(set-buffer-multibyte nil)
(insert uni)
(set-buffer-multibyte t)
(buffer-string)))))))
;; https://debbugs.gnu.org/33492
(ert-deftest buffer-tests-buffer-local-variables-undo ()
"Test that `buffer-undo-list' appears in `buffer-local-variables'."
(with-temp-buffer
(should (assq 'buffer-undo-list (buffer-local-variables)))))
(ert-deftest buffer-tests-inhibit-buffer-hooks ()
"Test `get-buffer-create' argument INHIBIT-BUFFER-HOOKS."
(let* (run-bluh (bluh (lambda () (setq run-bluh t))))
(unwind-protect
(let* ( run-kbh (kbh (lambda () (setq run-kbh t)))
run-kbqf (kbqf (lambda () (setq run-kbqf t))) )
;; Inhibited.
(add-hook 'buffer-list-update-hook bluh)
(with-current-buffer (generate-new-buffer " foo" t)
(add-hook 'kill-buffer-hook kbh nil t)
(add-hook 'kill-buffer-query-functions kbqf nil t)
(kill-buffer))
(with-temp-buffer)
(with-output-to-string)
(should-not run-bluh)
(should-not run-kbh)
(should-not run-kbqf)
;; Not inhibited.
(with-current-buffer (generate-new-buffer " foo")
(should run-bluh)
(add-hook 'kill-buffer-hook kbh nil t)
(add-hook 'kill-buffer-query-functions kbqf nil t)
(kill-buffer))
(should run-kbh)
(should run-kbqf))
(remove-hook 'buffer-list-update-hook bluh))))
;;; buffer-tests.el ends here