cgit.sxemacs.org Git - sxemacs/blob - tests/automated/extent-tests.el

   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 SXEmacs.
   9
  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.
  14
  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.
  19
  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/>.
  22
  23 ;;; Synched up with: Not in FSF.
  24
  25 ;;; Commentary:
  26
  27 ;; Test extents operations.
  28 ;; See test-harness.el for instructions on how to run these tests.
  29
  30 (eval-when-compile
  31   (condition-case nil
  32       (require 'test-harness)
  33     (file-error
  34      (push "." load-path)
  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))))
  38
  39
  40 ;;-----------------------------------------------------
  41 ;; Creating and attaching.
  42 ;;-----------------------------------------------------
  43
  44 (with-temp-buffer
  45   (let ((extent (make-extent nil nil))
  46         (string "somecoolstring"))
  47
  48     ;; Detached extent.
  49     (Assert (extent-detached-p extent))
  50
  51     ;; Put it in a buffer.
  52     (set-extent-endpoints extent 1 1 (current-buffer))
  53     (Assert (eq (extent-object extent) (current-buffer)))
  54
  55     ;; And then into another buffer.
  56     (with-temp-buffer
  57       (set-extent-endpoints extent 1 1 (current-buffer))
  58       (Assert (eq (extent-object extent) (current-buffer))))
  59
  60     ;; Now that the buffer doesn't exist, extent should be detached
  61     ;; again.
  62     (Assert (extent-detached-p extent))
  63
  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))
  67     )
  68
  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))
  75
  76     ;; Make it closed-closed.
  77     (set-extent-property extent 'end-closed t)
  78
  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))
  83
  84     ;; open-closed
  85     (set-extent-property extent 'start-open t)
  86
  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))
  91
  92     ;; open-open
  93     (set-extent-property extent 'end-open t)
  94
  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)))
  99
 100   )
 101
 102 ;;-----------------------------------------------------
 103 ;; Insertion behavior.
 104 ;;-----------------------------------------------------
 105
 106 (defun et-range (extent)
 107   "List (START-POSITION END-POSITION) of EXTENT."
 108   (list (extent-start-position extent)
 109         (extent-end-position extent)))
 110
 111 (defun et-insert-at (string position)
 112   "Insert STRING at POSITION in the current buffer."
 113   (save-excursion
 114     (goto-char position)
 115     (insert string)))
 116
 117 ;; Test insertion at the beginning, middle, and end of the extent.
 118
 119 ;; closed-open
 120
 121 (with-temp-buffer
 122   (insert "###eee###")
 123   (let ((e (make-extent 4 7)))
 124     ;; current state: "###[eee)###"
 125     ;;                 123 456 789
 126     (Assert (equal (et-range e) '(4 7)))
 127
 128     (et-insert-at "xxx" 4)
 129
 130     ;; current state: "###[xxxeee)###"
 131     ;;                 123 456789 012
 132     (Assert (equal (et-range e) '(4 10)))
 133
 134     (et-insert-at "yyy" 7)
 135
 136     ;; current state: "###[xxxyyyeee)###"
 137     ;;                 123 456789012 345
 138     (Assert (equal (et-range e) '(4 13)))
 139
 140     (et-insert-at "zzz" 13)
 141
 142     ;; current state: "###[xxxyyyeee)zzz###"
 143     ;;                 123 456789012 345678
 144     (Assert (equal (et-range e) '(4 13)))
 145     ))
 146
 147 ;; closed-closed
 148
 149 (with-temp-buffer
 150   (insert "###eee###")
 151   (let ((e (make-extent 4 7)))
 152     (put e 'end-closed t)
 153
 154     ;; current state: "###[eee]###"
 155     ;;                 123 456 789
 156     (Assert (equal (et-range e) '(4 7)))
 157
 158     (et-insert-at "xxx" 4)
 159
 160     ;; current state: "###[xxxeee]###"
 161     ;;                 123 456789 012
 162     (Assert (equal (et-range e) '(4 10)))
 163
 164     (et-insert-at "yyy" 7)
 165
 166     ;; current state: "###[xxxyyyeee]###"
 167     ;;                 123 456789012 345
 168     (Assert (equal (et-range e) '(4 13)))
 169
 170     (et-insert-at "zzz" 13)
 171
 172     ;; current state: "###[xxxyyyeeezzz]###"
 173     ;;                 123 456789012345 678
 174     (Assert (equal (et-range e) '(4 16)))
 175     ))
 176
 177 ;; open-closed
 178
 179 (with-temp-buffer
 180   (insert "###eee###")
 181   (let ((e (make-extent 4 7)))
 182     (put e 'start-open t)
 183     (put e 'end-closed t)
 184
 185     ;; current state: "###(eee]###"
 186     ;;                 123 456 789
 187     (Assert (equal (et-range e) '(4 7)))
 188
 189     (et-insert-at "xxx" 4)
 190
 191     ;; current state: "###xxx(eee]###"
 192     ;;                 123456 789 012
 193     (Assert (equal (et-range e) '(7 10)))
 194
 195     (et-insert-at "yyy" 8)
 196
 197     ;; current state: "###xxx(eyyyee]###"
 198     ;;                 123456 789012 345
 199     (Assert (equal (et-range e) '(7 13)))
 200
 201     (et-insert-at "zzz" 13)
 202
 203     ;; current state: "###xxx(eyyyeezzz]###"
 204     ;;                 123456 789012345 678
 205     (Assert (equal (et-range e) '(7 16)))
 206     ))
 207
 208 ;; open-open
 209
 210 (with-temp-buffer
 211   (insert "###eee###")
 212   (let ((e (make-extent 4 7)))
 213     (put e 'start-open t)
 214
 215     ;; current state: "###(eee)###"
 216     ;;                 123 456 789
 217     (Assert (equal (et-range e) '(4 7)))
 218
 219     (et-insert-at "xxx" 4)
 220
 221     ;; current state: "###xxx(eee)###"
 222     ;;                 123456 789 012
 223     (Assert (equal (et-range e) '(7 10)))
 224
 225     (et-insert-at "yyy" 8)
 226
 227     ;; current state: "###xxx(eyyyee)###"
 228     ;;                 123456 789012 345
 229     (Assert (equal (et-range e) '(7 13)))
 230
 231     (et-insert-at "zzz" 13)
 232
 233     ;; current state: "###xxx(eyyyee)zzz###"
 234     ;;                 123456 789012 345678
 235     (Assert (equal (et-range e) '(7 13)))
 236     ))
 237
 238
 239 ;;-----------------------------------------------------
 240 ;; Deletion behavior.
 241 ;;-----------------------------------------------------
 242
 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
 248   ;; the boundaries.
 249
 250   (with-temp-buffer
 251     (insert "xxxxxxxxxx")
 252     (let ((e (make-extent 3 9)))
 253       (set-extent-properties e props)
 254
 255       ;; current state: xx[xxxxxx]xx
 256       ;;                12 345678 90
 257       (Assert (equal (et-range e) '(3 9)))
 258
 259       (delete-region 1 2)
 260
 261       ;; current state: x[xxxxxx]xx
 262       ;;                1 234567 89
 263       (Assert (equal (et-range e) '(2 8)))
 264
 265       (delete-region 2 4)
 266
 267       ;; current state: x[xxxx]xx
 268       ;;                1 2345 67
 269       (Assert (equal (et-range e) '(2 6)))
 270
 271       (delete-region 1 3)
 272
 273       ;; current state: [xxx]xx
 274       ;;                 123 45
 275       (Assert (equal (et-range e) '(1 4)))
 276
 277       (delete-region 3 5)
 278
 279       ;; current state: [xx]x
 280       ;;                 12 3
 281       (Assert (equal (et-range e) '(1 3)))
 282
 283       )))
 284
 285 ;;; #### Should have a test for read-only-ness and insertion and
 286 ;;; deletion!
 287
 288 ;;-----------------------------------------------------
 289 ;; `detachable' property
 290 ;;-----------------------------------------------------
 291
 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
 297   ;; loop.
 298   (with-temp-buffer
 299     (insert "###eee###")
 300     (let ((e (make-extent 4 7)))
 301       (set-extent-properties e props)
 302       (Assert (get e 'detachable))
 303
 304       (Assert (not (extent-detached-p e)))
 305
 306       (delete-region 4 5)
 307       ;; ###ee### (not detached yet)
 308       (Assert (not (extent-detached-p e)))
 309
 310       (delete-region 4 6)
 311       ;; ###### (should be detached now)
 312       (Assert (extent-detached-p e))))
 313
 314   (with-temp-buffer
 315     (insert "###eee###")
 316     (let ((e (make-extent 4 7)))
 317       (set-extent-properties e props)
 318       (put e 'detachable nil)
 319       (Assert (not (get e 'detachable)))
 320
 321       (Assert (not (extent-detached-p e)))
 322
 323       (delete-region 4 5)
 324       ;; ###ee###
 325       (Assert (not (extent-detached-p e)))
 326
 327       (delete-region 4 6)
 328       ;; ###[]###
 329       (Assert (not (extent-detached-p e)))
 330       (Assert (equal (et-range e) '(4 4)))
 331       ))
 332   )
 333
 334
 335 ;;-----------------------------------------------------
 336 ;; Zero-length extents.
 337 ;;-----------------------------------------------------
 338
 339 ;; closed-open (should stay put)
 340 (with-temp-buffer
 341   (insert "######")
 342   (let ((e (make-extent 4 4)))
 343     (et-insert-at "foo" 4)
 344     (Assert (equal (et-range e) '(4 4)))))
 345
 346 ;; open-closed (should move)
 347 (with-temp-buffer
 348   (insert "######")
 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)))))
 354
 355 ;; closed-closed (should extend)
 356 (with-temp-buffer
 357   (insert "######")
 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)))))
 362
 363 ;; open-open (illegal; forced to behave like closed-open)
 364 (with-temp-buffer
 365   (insert "######")
 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)))))