Mercurial > hg > xemacs-beta
annotate tests/automated/extent-tests.el @ 4906:6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* cl-extra.el:
* cl-extra.el (cl-string-vector-equalp): Removed.
* cl-extra.el (cl-bit-vector-vector-equalp): Removed.
* cl-extra.el (cl-vector-array-equalp): Removed.
* cl-extra.el (cl-hash-table-contents-equalp): Removed.
* cl-extra.el (equalp): Removed.
* cl-extra.el (cl-mapcar-many):
Comment out the whole `equalp' implementation for the moment;
remove once we're sure the C implementation works.
* cl-macs.el:
* cl-macs.el (equalp):
Simplify the compiler-macro for `equalp' -- once it's in C,
we don't need to try so hard to expand it.
src/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* abbrev.c (abbrev_match_mapper):
* buffer.h (CANON_TABLE_OF):
* buffer.h:
* editfns.c (Fchar_equal):
* minibuf.c (scmp_1):
* text.c (qxestrcasecmp_i18n):
* text.c (qxestrncasecmp_i18n):
* text.c (qxetextcasecmp):
* text.c (qxetextcasecmp_matching):
Create new macro CANONCASE that converts to a canonical mapping
and use it to do caseless comparisons instead of DOWNCASE.
* alloc.c:
* alloc.c (cons_equal):
* alloc.c (vector_equal):
* alloc.c (string_equal):
* bytecode.c (compiled_function_equal):
* chartab.c (char_table_entry_equal):
* chartab.c (char_table_equal):
* data.c (weak_list_equal):
* data.c (weak_box_equal):
* data.c (ephemeron_equal):
* device-msw.c (equal_devmode):
* elhash.c (hash_table_equal):
* events.c (event_equal):
* extents.c (properties_equal):
* extents.c (extent_equal):
* faces.c:
* faces.c (face_equal):
* faces.c (face_hash):
* floatfns.c (float_equal):
* fns.c:
* fns.c (bit_vector_equal):
* fns.c (plists_differ):
* fns.c (Fplists_eq):
* fns.c (Fplists_equal):
* fns.c (Flax_plists_eq):
* fns.c (Flax_plists_equal):
* fns.c (internal_equal):
* fns.c (internal_equalp):
* fns.c (internal_equal_0):
* fns.c (syms_of_fns):
* glyphs.c (image_instance_equal):
* glyphs.c (glyph_equal):
* glyphs.c (glyph_hash):
* gui.c (gui_item_equal):
* lisp.h:
* lrecord.h (struct lrecord_implementation):
* marker.c (marker_equal):
* number.c (bignum_equal):
* number.c (ratio_equal):
* number.c (bigfloat_equal):
* objects.c (color_instance_equal):
* objects.c (font_instance_equal):
* opaque.c (equal_opaque):
* opaque.c (equal_opaque_ptr):
* rangetab.c (range_table_equal):
* specifier.c (specifier_equal):
Add a `foldcase' param to the equal() method and use it to implement
`equalp' comparisons. Also add to plists_differ(), although we
don't currently use it here.
Rewrite internal_equalp(). Implement cross-type vector comparisons.
Don't implement our own handling of numeric promotion -- just use
the `=' primitive.
Add internal_equal_0(), which takes a `foldcase' param and calls
either internal_equal() or internal_equalp().
* buffer.h:
When given a 0 for buffer (which is the norm when functions don't
have a specific buffer available), use the current buffer's table,
not `standard-case-table'; otherwise the current settings are
ignored.
* casetab.c:
* casetab.c (set_case_table):
When handling old-style vectors of 256 in `set-case-table' don't
overwrite the existing table! Instead create a new table and
populate.
* device-msw.c (sync_printer_with_devmode):
* lisp.h:
* text.c (lisp_strcasecmp_ascii):
Rename lisp_strcasecmp to lisp_strcasecmp_ascii and use
lisp_strcasecmp_i18n for caseless comparisons in some places.
* elhash.c:
Delete unused lisp_string_hash and lisp_string_equal().
* events.h:
* keymap-buttons.h:
* keymap.h:
* keymap.c (keymap_lookup_directly):
* keymap.c (keymap_store):
* keymap.c (FROB):
* keymap.c (key_desc_list_to_event):
* keymap.c (describe_map_mapper):
* keymap.c (INCLUDE_BUTTON_ZERO):
New file keymap-buttons.h; use to handle buttons 1-26 in place of
duplicating code 26 times.
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-msw.c (mswindows_init_frame_1):
Fix some comments about internal_equal() in redisplay that don't
apply any more.
* keymap-slots.h:
* keymap.c:
New file keymap-slots.h. Use it to notate the slots in a keymap
structure, similar to frameslots.h or coding-system-slots.h.
* keymap.c (MARKED_SLOT):
* keymap.c (keymap_equal):
* keymap.c (keymap_hash):
Implement.
tests/ChangeLog addition:
2010-02-01 Ben Wing <ben@xemacs.org>
* automated/case-tests.el:
* automated/case-tests.el (uni-mappings):
* automated/search-tests.el:
Delete old pristine-case-table code. Rewrite the Unicode torture
test to take into account whether overlapping mappings exist for
more than one character, and not doing the upcase/downcase
comparisons in such cases.
* automated/lisp-tests.el (foo):
* automated/lisp-tests.el (string-variable):
* automated/lisp-tests.el (featurep):
Replace Assert (equal ... with Assert-equal; same for other types
of equality. Replace some awkward equivalents of Assert-equalp
with Assert-equalp. Add lots of equalp tests.
* automated/case-tests.el:
* automated/regexp-tests.el:
* automated/search-tests.el:
Fix up the comments at the top of the files. Move rules about where
to put tests into case-tests.el.
* automated/test-harness.el:
* automated/test-harness.el (test-harness-aborted-summary-template): New.
* automated/test-harness.el (test-harness-from-buffer):
* automated/test-harness.el (batch-test-emacs):
Fix Assert-test-not. Create Assert-not-equal and variants.
Delete the doc strings from all these convenience functions to avoid
excessive repetition; instead use one copy in a comment.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Mon, 01 Feb 2010 01:02:40 -0600 |
| parents | 189fb67ca31a |
| children | 0f66906b6e37 |
| rev | line source |
|---|---|
| 468 | 1 ;; Copyright (C) 2001 Free Software Foundation, Inc. |
| 2 | |
| 3 ;; Author: Hrvoje Niksic <hniksic@xemacs.org> | |
| 4 ;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org> | |
| 5 ;; Created: 1999 | |
| 6 ;; Keywords: tests | |
| 7 | |
| 8 ;; This file is part of XEmacs. | |
| 9 | |
| 10 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 11 ;; under the terms of the GNU General Public License as published by | |
| 12 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 13 ;; any later version. | |
| 14 | |
| 15 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 16 ;; 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. | |
| 19 | |
| 20 ;; You should have received a copy of the GNU General Public License | |
| 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
| 23 ;; 02111-1307, USA. | |
| 24 | |
| 25 ;;; Synched up with: Not in FSF. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ;; Test extents operations. | |
| 30 ;; See test-harness.el for instructions on how to run these tests. | |
| 31 | |
| 32 (eval-when-compile | |
| 33 (condition-case nil | |
| 34 (require 'test-harness) | |
| 35 (file-error | |
| 36 (push "." load-path) | |
| 37 (when (and (boundp 'load-file-name) (stringp load-file-name)) | |
| 38 (push (file-name-directory load-file-name) load-path)) | |
| 39 (require 'test-harness)))) | |
| 40 | |
| 41 | |
| 42 ;;----------------------------------------------------- | |
| 43 ;; Creating and attaching. | |
| 44 ;;----------------------------------------------------- | |
| 45 | |
| 46 (with-temp-buffer | |
| 47 (let ((extent (make-extent nil nil)) | |
| 48 (string "somecoolstring")) | |
| 49 | |
| 50 ;; Detached extent. | |
| 51 (Assert (extent-detached-p extent)) | |
| 52 | |
| 53 ;; Put it in a buffer. | |
| 54 (set-extent-endpoints extent 1 1 (current-buffer)) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
55 (Assert-eq (extent-object extent) (current-buffer)) |
| 468 | 56 |
| 57 ;; And then into another buffer. | |
| 58 (with-temp-buffer | |
| 59 (set-extent-endpoints extent 1 1 (current-buffer)) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
60 (Assert-eq (extent-object extent) (current-buffer))) |
| 468 | 61 |
| 62 ;; Now that the buffer doesn't exist, extent should be detached | |
| 63 ;; again. | |
| 64 (Assert (extent-detached-p extent)) | |
| 65 | |
| 66 ;; This line crashes XEmacs 21.2.46 and prior. | |
| 67 (set-extent-endpoints extent 1 (length string) string) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
68 (Assert-eq (extent-object extent) string) |
| 468 | 69 ) |
| 70 | |
| 71 (let ((extent (make-extent 1 1))) | |
| 72 ;; By default, extent should be closed-open | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
73 (Assert-eq (get extent 'start-closed) t) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
74 (Assert-eq (get extent 'start-open) nil) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
75 (Assert-eq (get extent 'end-open) t) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
76 (Assert-eq (get extent 'end-closed) nil) |
| 468 | 77 |
| 78 ;; Make it closed-closed. | |
| 79 (set-extent-property extent 'end-closed t) | |
| 80 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
81 (Assert-eq (get extent 'start-closed) t) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
82 (Assert-eq (get extent 'start-open) nil) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
83 (Assert-eq (get extent 'end-open) nil) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
84 (Assert-eq (get extent 'end-closed) t) |
| 468 | 85 |
| 86 ;; open-closed | |
| 87 (set-extent-property extent 'start-open t) | |
| 88 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
89 (Assert-eq (get extent 'start-closed) nil) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
90 (Assert-eq (get extent 'start-open) t) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
91 (Assert-eq (get extent 'end-open) nil) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
92 (Assert-eq (get extent 'end-closed) t) |
| 468 | 93 |
| 94 ;; open-open | |
| 95 (set-extent-property extent 'end-open t) | |
| 96 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
97 (Assert-eq (get extent 'start-closed) nil) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
98 (Assert-eq (get extent 'start-open) t) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
99 (Assert-eq (get extent 'end-open) t) |
|
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
100 (Assert-eq (get extent 'end-closed) nil)) |
| 468 | 101 |
| 102 ) | |
| 103 | |
| 104 ;;----------------------------------------------------- | |
| 105 ;; Insertion behavior. | |
| 106 ;;----------------------------------------------------- | |
| 107 | |
| 108 (defun et-range (extent) | |
| 109 "List (START-POSITION END-POSITION) of EXTENT." | |
| 110 (list (extent-start-position extent) | |
| 111 (extent-end-position extent))) | |
| 112 | |
| 113 (defun et-insert-at (string position) | |
| 114 "Insert STRING at POSITION in the current buffer." | |
| 115 (save-excursion | |
| 116 (goto-char position) | |
| 117 (insert string))) | |
| 118 | |
| 119 ;; Test insertion at the beginning, middle, and end of the extent. | |
| 120 | |
| 121 ;; closed-open | |
| 122 | |
| 123 (with-temp-buffer | |
| 124 (insert "###eee###") | |
| 125 (let ((e (make-extent 4 7))) | |
| 126 ;; current state: "###[eee)###" | |
| 127 ;; 123 456 789 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
128 (Assert-equal (et-range e) '(4 7)) |
| 468 | 129 |
| 130 (et-insert-at "xxx" 4) | |
| 131 | |
| 132 ;; current state: "###[xxxeee)###" | |
| 133 ;; 123 456789 012 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
134 (Assert-equal (et-range e) '(4 10)) |
| 468 | 135 |
| 136 (et-insert-at "yyy" 7) | |
| 137 | |
| 138 ;; current state: "###[xxxyyyeee)###" | |
| 139 ;; 123 456789012 345 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
140 (Assert-equal (et-range e) '(4 13)) |
| 468 | 141 |
| 142 (et-insert-at "zzz" 13) | |
| 143 | |
| 144 ;; current state: "###[xxxyyyeee)zzz###" | |
| 145 ;; 123 456789012 345678 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
146 (Assert-equal (et-range e) '(4 13)) |
| 468 | 147 )) |
| 148 | |
| 149 ;; closed-closed | |
| 150 | |
| 151 (with-temp-buffer | |
| 152 (insert "###eee###") | |
| 153 (let ((e (make-extent 4 7))) | |
| 154 (put e 'end-closed t) | |
| 155 | |
| 156 ;; current state: "###[eee]###" | |
| 157 ;; 123 456 789 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
158 (Assert-equal (et-range e) '(4 7)) |
| 468 | 159 |
| 160 (et-insert-at "xxx" 4) | |
| 161 | |
| 162 ;; current state: "###[xxxeee]###" | |
| 163 ;; 123 456789 012 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
164 (Assert-equal (et-range e) '(4 10)) |
| 468 | 165 |
| 166 (et-insert-at "yyy" 7) | |
| 167 | |
| 168 ;; current state: "###[xxxyyyeee]###" | |
| 169 ;; 123 456789012 345 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
170 (Assert-equal (et-range e) '(4 13)) |
| 468 | 171 |
| 172 (et-insert-at "zzz" 13) | |
| 173 | |
| 174 ;; current state: "###[xxxyyyeeezzz]###" | |
| 175 ;; 123 456789012345 678 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
176 (Assert-equal (et-range e) '(4 16)) |
| 468 | 177 )) |
| 178 | |
| 179 ;; open-closed | |
| 180 | |
| 181 (with-temp-buffer | |
| 182 (insert "###eee###") | |
| 183 (let ((e (make-extent 4 7))) | |
| 184 (put e 'start-open t) | |
| 185 (put e 'end-closed t) | |
| 186 | |
| 187 ;; current state: "###(eee]###" | |
| 188 ;; 123 456 789 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
189 (Assert-equal (et-range e) '(4 7)) |
| 468 | 190 |
| 191 (et-insert-at "xxx" 4) | |
| 192 | |
| 193 ;; current state: "###xxx(eee]###" | |
| 194 ;; 123456 789 012 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
195 (Assert-equal (et-range e) '(7 10)) |
| 468 | 196 |
| 197 (et-insert-at "yyy" 8) | |
| 198 | |
| 199 ;; current state: "###xxx(eyyyee]###" | |
| 200 ;; 123456 789012 345 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
201 (Assert-equal (et-range e) '(7 13)) |
| 468 | 202 |
| 203 (et-insert-at "zzz" 13) | |
| 204 | |
| 205 ;; current state: "###xxx(eyyyeezzz]###" | |
| 206 ;; 123456 789012345 678 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
207 (Assert-equal (et-range e) '(7 16)) |
| 468 | 208 )) |
| 209 | |
| 210 ;; open-open | |
| 211 | |
| 212 (with-temp-buffer | |
| 213 (insert "###eee###") | |
| 214 (let ((e (make-extent 4 7))) | |
| 215 (put e 'start-open t) | |
| 216 | |
| 217 ;; current state: "###(eee)###" | |
| 218 ;; 123 456 789 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
219 (Assert-equal (et-range e) '(4 7)) |
| 468 | 220 |
| 221 (et-insert-at "xxx" 4) | |
| 222 | |
| 223 ;; current state: "###xxx(eee)###" | |
| 224 ;; 123456 789 012 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
225 (Assert-equal (et-range e) '(7 10)) |
| 468 | 226 |
| 227 (et-insert-at "yyy" 8) | |
| 228 | |
| 229 ;; current state: "###xxx(eyyyee)###" | |
| 230 ;; 123456 789012 345 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
231 (Assert-equal (et-range e) '(7 13)) |
| 468 | 232 |
| 233 (et-insert-at "zzz" 13) | |
| 234 | |
| 235 ;; current state: "###xxx(eyyyee)zzz###" | |
| 236 ;; 123456 789012 345678 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
237 (Assert-equal (et-range e) '(7 13)) |
| 468 | 238 )) |
| 239 | |
| 240 | |
| 241 ;;----------------------------------------------------- | |
| 242 ;; Deletion behavior. | |
| 243 ;;----------------------------------------------------- | |
| 244 | |
| 245 (dolist (props '((start-closed t end-open t) | |
| 246 (start-closed t end-open nil) | |
| 247 (start-closed nil end-open nil) | |
| 248 (start-closed nil end-open t))) | |
| 249 ;; Deletion needs to behave the same regardless of the open-ness of | |
| 250 ;; the boundaries. | |
| 251 | |
| 252 (with-temp-buffer | |
| 253 (insert "xxxxxxxxxx") | |
| 254 (let ((e (make-extent 3 9))) | |
| 255 (set-extent-properties e props) | |
| 256 | |
| 257 ;; current state: xx[xxxxxx]xx | |
| 258 ;; 12 345678 90 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
259 (Assert-equal (et-range e) '(3 9)) |
| 468 | 260 |
| 261 (delete-region 1 2) | |
| 262 | |
| 263 ;; current state: x[xxxxxx]xx | |
| 264 ;; 1 234567 89 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
265 (Assert-equal (et-range e) '(2 8)) |
| 468 | 266 |
| 267 (delete-region 2 4) | |
| 268 | |
| 269 ;; current state: x[xxxx]xx | |
| 270 ;; 1 2345 67 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
271 (Assert-equal (et-range e) '(2 6)) |
| 468 | 272 |
| 273 (delete-region 1 3) | |
| 274 | |
| 275 ;; current state: [xxx]xx | |
| 276 ;; 123 45 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
277 (Assert-equal (et-range e) '(1 4)) |
| 468 | 278 |
| 279 (delete-region 3 5) | |
| 280 | |
| 281 ;; current state: [xx]x | |
| 282 ;; 12 3 | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
283 (Assert-equal (et-range e) '(1 3)) |
| 468 | 284 |
| 285 ))) | |
| 286 | |
| 287 ;;; #### Should have a test for read-only-ness and insertion and | |
| 288 ;;; deletion! | |
| 289 | |
| 290 ;;----------------------------------------------------- | |
| 291 ;; `detachable' property | |
| 292 ;;----------------------------------------------------- | |
| 293 | |
| 294 (dolist (props '((start-closed t end-open t) | |
| 295 (start-closed t end-open nil) | |
| 296 (start-closed nil end-open nil) | |
| 297 (start-closed nil end-open t))) | |
| 298 ;; `detachable' shouldn't relate to region properties, hence the | |
| 299 ;; loop. | |
| 300 (with-temp-buffer | |
| 301 (insert "###eee###") | |
| 302 (let ((e (make-extent 4 7))) | |
| 303 (set-extent-properties e props) | |
| 304 (Assert (get e 'detachable)) | |
| 305 | |
| 306 (Assert (not (extent-detached-p e))) | |
| 307 | |
| 308 (delete-region 4 5) | |
| 309 ;; ###ee### (not detached yet) | |
| 310 (Assert (not (extent-detached-p e))) | |
| 311 | |
| 312 (delete-region 4 6) | |
| 313 ;; ###### (should be detached now) | |
| 314 (Assert (extent-detached-p e)))) | |
| 315 | |
| 316 (with-temp-buffer | |
| 317 (insert "###eee###") | |
| 318 (let ((e (make-extent 4 7))) | |
| 319 (set-extent-properties e props) | |
| 320 (put e 'detachable nil) | |
| 321 (Assert (not (get e 'detachable))) | |
| 322 | |
| 323 (Assert (not (extent-detached-p e))) | |
| 324 | |
| 325 (delete-region 4 5) | |
| 326 ;; ###ee### | |
| 327 (Assert (not (extent-detached-p e))) | |
| 328 | |
| 329 (delete-region 4 6) | |
| 330 ;; ###[]### | |
| 331 (Assert (not (extent-detached-p e))) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
332 (Assert-equal (et-range e) '(4 4)) |
| 468 | 333 )) |
| 334 ) | |
| 335 | |
| 336 | |
| 337 ;;----------------------------------------------------- | |
| 338 ;; Zero-length extents. | |
| 339 ;;----------------------------------------------------- | |
| 340 | |
| 341 ;; closed-open (should stay put) | |
| 342 (with-temp-buffer | |
| 343 (insert "######") | |
| 344 (let ((e (make-extent 4 4))) | |
| 345 (et-insert-at "foo" 4) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
346 (Assert-equal (et-range e) '(4 4)))) |
| 468 | 347 |
| 348 ;; open-closed (should move) | |
| 349 (with-temp-buffer | |
| 350 (insert "######") | |
| 351 (let ((e (make-extent 4 4))) | |
| 352 (put e 'start-open t) | |
| 353 (put e 'end-closed t) | |
| 354 (et-insert-at "foo" 4) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
355 (Assert-equal (et-range e) '(7 7)))) |
| 468 | 356 |
| 357 ;; closed-closed (should extend) | |
| 358 (with-temp-buffer | |
| 359 (insert "######") | |
| 360 (let ((e (make-extent 4 4))) | |
| 361 (put e 'end-closed t) | |
| 362 (et-insert-at "foo" 4) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
363 (Assert-equal (et-range e) '(4 7)))) |
| 468 | 364 |
| 365 ;; open-open (illegal; forced to behave like closed-open) | |
| 366 (with-temp-buffer | |
| 367 (insert "######") | |
| 368 (let ((e (make-extent 4 4))) | |
| 369 (put e 'start-open t) | |
| 370 (et-insert-at "foo" 4) | |
|
4855
189fb67ca31a
Create Assert-eq, Assert-equal, etc.
Ben Wing <ben@xemacs.org>
parents:
468
diff
changeset
|
371 (Assert-equal (et-range e) '(4 4)))) |