1 ;; Copyright (C) 2001 Free Software Foundation, Inc.
3 ;; Author: Hrvoje Niksic <hniksic@xemacs.org>
4 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
8 ;; This file is part of SXEmacs.
10 ;; SXEmacs is free software: you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by the
12 ;; Free Software Foundation, either version 3 of the License, or (at your
13 ;; option) any later version.
15 ;; SXEmacs is distributed in the hope that it will be
16 ;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Synched up with: Not in FSF.
27 ;; Test extents operations.
28 ;; See test-harness.el for instructions on how to run these tests.
32 (require 'test-harness)
35 (when (and (boundp 'load-file-name) (stringp load-file-name))
36 (push (file-name-directory load-file-name) load-path))
37 (require 'test-harness))))
40 ;;-----------------------------------------------------
41 ;; Creating and attaching.
42 ;;-----------------------------------------------------
45 (let ((extent (make-extent nil nil))
46 (string "somecoolstring"))
49 (Assert (extent-detached-p extent))
51 ;; Put it in a buffer.
52 (set-extent-endpoints extent 1 1 (current-buffer))
53 (Assert (eq (extent-object extent) (current-buffer)))
55 ;; And then into another buffer.
57 (set-extent-endpoints extent 1 1 (current-buffer))
58 (Assert (eq (extent-object extent) (current-buffer))))
60 ;; Now that the buffer doesn't exist, extent should be detached
62 (Assert (extent-detached-p extent))
64 ;; This line crashes XEmacs 21.2.46 and prior.
65 (set-extent-endpoints extent 1 (length string) string)
66 (Assert (eq (extent-object extent) string))
69 (let ((extent (make-extent 1 1)))
70 ;; By default, extent should be closed-open
71 (Assert (eq (get extent 'start-closed) t))
72 (Assert (eq (get extent 'start-open) nil))
73 (Assert (eq (get extent 'end-open) t))
74 (Assert (eq (get extent 'end-closed) nil))
76 ;; Make it closed-closed.
77 (set-extent-property extent 'end-closed t)
79 (Assert (eq (get extent 'start-closed) t))
80 (Assert (eq (get extent 'start-open) nil))
81 (Assert (eq (get extent 'end-open) nil))
82 (Assert (eq (get extent 'end-closed) t))
85 (set-extent-property extent 'start-open t)
87 (Assert (eq (get extent 'start-closed) nil))
88 (Assert (eq (get extent 'start-open) t))
89 (Assert (eq (get extent 'end-open) nil))
90 (Assert (eq (get extent 'end-closed) t))
93 (set-extent-property extent 'end-open t)
95 (Assert (eq (get extent 'start-closed) nil))
96 (Assert (eq (get extent 'start-open) t))
97 (Assert (eq (get extent 'end-open) t))
98 (Assert (eq (get extent 'end-closed) nil)))
102 ;;-----------------------------------------------------
103 ;; Insertion behavior.
104 ;;-----------------------------------------------------
106 (defun et-range (extent)
107 "List (START-POSITION END-POSITION) of EXTENT."
108 (list (extent-start-position extent)
109 (extent-end-position extent)))
111 (defun et-insert-at (string position)
112 "Insert STRING at POSITION in the current buffer."
117 ;; Test insertion at the beginning, middle, and end of the extent.
123 (let ((e (make-extent 4 7)))
124 ;; current state: "###[eee)###"
126 (Assert-Equal (et-range e) '(4 7))
128 (et-insert-at "xxx" 4)
130 ;; current state: "###[xxxeee)###"
132 (Assert-Equal (et-range e) '(4 10))
134 (et-insert-at "yyy" 7)
136 ;; current state: "###[xxxyyyeee)###"
138 (Assert-Equal (et-range e) '(4 13))
140 (et-insert-at "zzz" 13)
142 ;; current state: "###[xxxyyyeee)zzz###"
143 ;; 123 456789012 345678
144 (Assert-Equal (et-range e) '(4 13))
151 (let ((e (make-extent 4 7)))
152 (put e 'end-closed t)
154 ;; current state: "###[eee]###"
156 (Assert-Equal (et-range e) '(4 7))
158 (et-insert-at "xxx" 4)
160 ;; current state: "###[xxxeee]###"
162 (Assert-Equal (et-range e) '(4 10))
164 (et-insert-at "yyy" 7)
166 ;; current state: "###[xxxyyyeee]###"
168 (Assert-Equal (et-range e) '(4 13))
170 (et-insert-at "zzz" 13)
172 ;; current state: "###[xxxyyyeeezzz]###"
173 ;; 123 456789012345 678
174 (Assert-Equal (et-range e) '(4 16))
181 (let ((e (make-extent 4 7)))
182 (put e 'start-open t)
183 (put e 'end-closed t)
185 ;; current state: "###(eee]###"
187 (Assert-Equal (et-range e) '(4 7))
189 (et-insert-at "xxx" 4)
191 ;; current state: "###xxx(eee]###"
193 (Assert-Equal (et-range e) '(7 10))
195 (et-insert-at "yyy" 8)
197 ;; current state: "###xxx(eyyyee]###"
199 (Assert-Equal (et-range e) '(7 13))
201 (et-insert-at "zzz" 13)
203 ;; current state: "###xxx(eyyyeezzz]###"
204 ;; 123456 789012345 678
205 (Assert-Equal (et-range e) '(7 16))
212 (let ((e (make-extent 4 7)))
213 (put e 'start-open t)
215 ;; current state: "###(eee)###"
217 (Assert-Equal (et-range e) '(4 7))
219 (et-insert-at "xxx" 4)
221 ;; current state: "###xxx(eee)###"
223 (Assert-Equal (et-range e) '(7 10))
225 (et-insert-at "yyy" 8)
227 ;; current state: "###xxx(eyyyee)###"
229 (Assert-Equal (et-range e) '(7 13))
231 (et-insert-at "zzz" 13)
233 ;; current state: "###xxx(eyyyee)zzz###"
234 ;; 123456 789012 345678
235 (Assert-Equal (et-range e) '(7 13))
239 ;;-----------------------------------------------------
240 ;; Deletion behavior.
241 ;;-----------------------------------------------------
243 (dolist (props '((start-closed t end-open t)
244 (start-closed t end-open nil)
245 (start-closed nil end-open nil)
246 (start-closed nil end-open t)))
247 ;; Deletion needs to behave the same regardless of the open-ness of
251 (insert "xxxxxxxxxx")
252 (let ((e (make-extent 3 9)))
253 (set-extent-properties e props)
255 ;; current state: xx[xxxxxx]xx
257 (Assert-Equal (et-range e) '(3 9))
261 ;; current state: x[xxxxxx]xx
263 (Assert-Equal (et-range e) '(2 8))
267 ;; current state: x[xxxx]xx
269 (Assert-Equal (et-range e) '(2 6))
273 ;; current state: [xxx]xx
275 (Assert-Equal (et-range e) '(1 4))
279 ;; current state: [xx]x
281 (Assert-Equal (et-range e) '(1 3))
285 ;;; #### Should have a test for read-only-ness and insertion and
288 ;;-----------------------------------------------------
289 ;; `detachable' property
290 ;;-----------------------------------------------------
292 (dolist (props '((start-closed t end-open t)
293 (start-closed t end-open nil)
294 (start-closed nil end-open nil)
295 (start-closed nil end-open t)))
296 ;; `detachable' shouldn't relate to region properties, hence the
300 (let ((e (make-extent 4 7)))
301 (set-extent-properties e props)
302 (Assert (get e 'detachable))
304 (Assert (not (extent-detached-p e)))
307 ;; ###ee### (not detached yet)
308 (Assert (not (extent-detached-p e)))
311 ;; ###### (should be detached now)
312 (Assert (extent-detached-p e))))
316 (let ((e (make-extent 4 7)))
317 (set-extent-properties e props)
318 (put e 'detachable nil)
319 (Assert (not (get e 'detachable)))
321 (Assert (not (extent-detached-p e)))
325 (Assert (not (extent-detached-p e)))
329 (Assert (not (extent-detached-p e)))
330 (Assert-Equal (et-range e) '(4 4))
335 ;;-----------------------------------------------------
336 ;; Zero-length extents.
337 ;;-----------------------------------------------------
339 ;; closed-open (should stay put)
342 (let ((e (make-extent 4 4)))
343 (et-insert-at "foo" 4)
344 (Assert-Equal (et-range e) '(4 4))))
346 ;; open-closed (should move)
349 (let ((e (make-extent 4 4)))
350 (put e 'start-open t)
351 (put e 'end-closed t)
352 (et-insert-at "foo" 4)
353 (Assert-Equal (et-range e) '(7 7))))
355 ;; closed-closed (should extend)
358 (let ((e (make-extent 4 4)))
359 (put e 'end-closed t)
360 (et-insert-at "foo" 4)
361 (Assert-Equal (et-range e) '(4 7))))
363 ;; open-open (illegal; forced to behave like closed-open)
366 (let ((e (make-extent 4 4)))
367 (put e 'start-open t)
368 (et-insert-at "foo" 4)
369 (Assert-Equal (et-range e) '(4 4))))