git.chise.org Git - chise/xemacs-chise.git.1/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 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))
  55     (Assert (eq (extent-object extent) (current-buffer)))
  56
  57     ;; And then into another buffer.
  58     (with-temp-buffer
  59       (set-extent-endpoints extent 1 1 (current-buffer))
  60       (Assert (eq (extent-object extent) (current-buffer))))
  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)
  68     (Assert (eq (extent-object extent) string))
  69     )
  70
  71   (let ((extent (make-extent 1 1)))
  72     ;; By default, extent should be closed-open
  73     (Assert (eq (get extent 'start-closed) t))
  74     (Assert (eq (get extent 'start-open) nil))
  75     (Assert (eq (get extent 'end-open) t))
  76     (Assert (eq (get extent 'end-closed) nil))
  77
  78     ;; Make it closed-closed.
  79     (set-extent-property extent 'end-closed t)
  80
  81     (Assert (eq (get extent 'start-closed) t))
  82     (Assert (eq (get extent 'start-open) nil))
  83     (Assert (eq (get extent 'end-open) nil))
  84     (Assert (eq (get extent 'end-closed) t))
  85
  86     ;; open-closed
  87     (set-extent-property extent 'start-open t)
  88
  89     (Assert (eq (get extent 'start-closed) nil))
  90     (Assert (eq (get extent 'start-open) t))
  91     (Assert (eq (get extent 'end-open) nil))
  92     (Assert (eq (get extent 'end-closed) t))
  93
  94     ;; open-open
  95     (set-extent-property extent 'end-open t)
  96
  97     (Assert (eq (get extent 'start-closed) nil))
  98     (Assert (eq (get extent 'start-open) t))
  99     (Assert (eq (get extent 'end-open) t))
 100     (Assert (eq (get extent 'end-closed) nil)))
 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
 128     (Assert (equal (et-range e) '(4 7)))
 129
 130     (et-insert-at "xxx" 4)
 131
 132     ;; current state: "###[xxxeee)###"
 133     ;;                 123 456789 012
 134     (Assert (equal (et-range e) '(4 10)))
 135
 136     (et-insert-at "yyy" 7)
 137
 138     ;; current state: "###[xxxyyyeee)###"
 139     ;;                 123 456789012 345
 140     (Assert (equal (et-range e) '(4 13)))
 141
 142     (et-insert-at "zzz" 13)
 143
 144     ;; current state: "###[xxxyyyeee)zzz###"
 145     ;;                 123 456789012 345678
 146     (Assert (equal (et-range e) '(4 13)))
 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
 158     (Assert (equal (et-range e) '(4 7)))
 159
 160     (et-insert-at "xxx" 4)
 161
 162     ;; current state: "###[xxxeee]###"
 163     ;;                 123 456789 012
 164     (Assert (equal (et-range e) '(4 10)))
 165
 166     (et-insert-at "yyy" 7)
 167
 168     ;; current state: "###[xxxyyyeee]###"
 169     ;;                 123 456789012 345
 170     (Assert (equal (et-range e) '(4 13)))
 171
 172     (et-insert-at "zzz" 13)
 173
 174     ;; current state: "###[xxxyyyeeezzz]###"
 175     ;;                 123 456789012345 678
 176     (Assert (equal (et-range e) '(4 16)))
 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
 189     (Assert (equal (et-range e) '(4 7)))
 190
 191     (et-insert-at "xxx" 4)
 192
 193     ;; current state: "###xxx(eee]###"
 194     ;;                 123456 789 012
 195     (Assert (equal (et-range e) '(7 10)))
 196
 197     (et-insert-at "yyy" 8)
 198
 199     ;; current state: "###xxx(eyyyee]###"
 200     ;;                 123456 789012 345
 201     (Assert (equal (et-range e) '(7 13)))
 202
 203     (et-insert-at "zzz" 13)
 204
 205     ;; current state: "###xxx(eyyyeezzz]###"
 206     ;;                 123456 789012345 678
 207     (Assert (equal (et-range e) '(7 16)))
 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
 219     (Assert (equal (et-range e) '(4 7)))
 220
 221     (et-insert-at "xxx" 4)
 222
 223     ;; current state: "###xxx(eee)###"
 224     ;;                 123456 789 012
 225     (Assert (equal (et-range e) '(7 10)))
 226
 227     (et-insert-at "yyy" 8)
 228
 229     ;; current state: "###xxx(eyyyee)###"
 230     ;;                 123456 789012 345
 231     (Assert (equal (et-range e) '(7 13)))
 232
 233     (et-insert-at "zzz" 13)
 234
 235     ;; current state: "###xxx(eyyyee)zzz###"
 236     ;;                 123456 789012 345678
 237     (Assert (equal (et-range e) '(7 13)))
 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
 259       (Assert (equal (et-range e) '(3 9)))
 260
 261       (delete-region 1 2)
 262
 263       ;; current state: x[xxxxxx]xx
 264       ;;                1 234567 89
 265       (Assert (equal (et-range e) '(2 8)))
 266
 267       (delete-region 2 4)
 268
 269       ;; current state: x[xxxx]xx
 270       ;;                1 2345 67
 271       (Assert (equal (et-range e) '(2 6)))
 272
 273       (delete-region 1 3)
 274
 275       ;; current state: [xxx]xx
 276       ;;                 123 45
 277       (Assert (equal (et-range e) '(1 4)))
 278
 279       (delete-region 3 5)
 280
 281       ;; current state: [xx]x
 282       ;;                 12 3
 283       (Assert (equal (et-range e) '(1 3)))
 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)))
 332       (Assert (equal (et-range e) '(4 4)))
 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)
 346     (Assert (equal (et-range e) '(4 4)))))
 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)
 355     (Assert (equal (et-range e) '(7 7)))))
 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)
 363     (Assert (equal (et-range e) '(4 7)))))
 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)
 371     (Assert (equal (et-range e) '(4 4)))))