Initial revision

diff --git a/tests/automated/extent-tests.el b/tests/automated/extent-tests.el
new file mode 100644 (file)
index 0000000..d7f4d4f
--- /dev/null
+++ b/tests/automated/extent-tests.el
@@ -0,0 +1,371 @@
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; Author: Hrvoje Niksic <hniksic@xemacs.org>
+;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
+;; Created: 1999
+;; Keywords: tests
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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 2, or (at your option)
+;; any later version.
+
+;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Commentary:
+
+;; Test extents operations.
+;; See test-harness.el for instructions on how to run these tests.
+
+(eval-when-compile
+  (condition-case nil
+      (require 'test-harness)
+    (file-error
+     (push "." load-path)
+     (when (and (boundp 'load-file-name) (stringp load-file-name))
+       (push (file-name-directory load-file-name) load-path))
+     (require 'test-harness))))
+
+
+;;-----------------------------------------------------
+;; Creating and attaching.
+;;-----------------------------------------------------
+
+(with-temp-buffer
+  (let ((extent (make-extent nil nil))
+       (string "somecoolstring"))
+
+    ;; Detached extent.
+    (Assert (extent-detached-p extent))
+
+    ;; Put it in a buffer.
+    (set-extent-endpoints extent 1 1 (current-buffer))
+    (Assert (eq (extent-object extent) (current-buffer)))
+
+    ;; And then into another buffer.
+    (with-temp-buffer
+      (set-extent-endpoints extent 1 1 (current-buffer))
+      (Assert (eq (extent-object extent) (current-buffer))))
+
+    ;; Now that the buffer doesn't exist, extent should be detached
+    ;; again.
+    (Assert (extent-detached-p extent))
+
+    ;; This line crashes XEmacs 21.2.46 and prior.
+    (set-extent-endpoints extent 1 (length string) string)
+    (Assert (eq (extent-object extent) string))
+    )
+
+  (let ((extent (make-extent 1 1)))
+    ;; By default, extent should be closed-open
+    (Assert (eq (get extent 'start-closed) t))
+    (Assert (eq (get extent 'start-open) nil))
+    (Assert (eq (get extent 'end-open) t))
+    (Assert (eq (get extent 'end-closed) nil))
+
+    ;; Make it closed-closed.
+    (set-extent-property extent 'end-closed t)
+
+    (Assert (eq (get extent 'start-closed) t))
+    (Assert (eq (get extent 'start-open) nil))
+    (Assert (eq (get extent 'end-open) nil))
+    (Assert (eq (get extent 'end-closed) t))
+
+    ;; open-closed
+    (set-extent-property extent 'start-open t)
+
+    (Assert (eq (get extent 'start-closed) nil))
+    (Assert (eq (get extent 'start-open) t))
+    (Assert (eq (get extent 'end-open) nil))
+    (Assert (eq (get extent 'end-closed) t))
+
+    ;; open-open
+    (set-extent-property extent 'end-open t)
+
+    (Assert (eq (get extent 'start-closed) nil))
+    (Assert (eq (get extent 'start-open) t))
+    (Assert (eq (get extent 'end-open) t))
+    (Assert (eq (get extent 'end-closed) nil)))
+
+  )
+
+;;-----------------------------------------------------
+;; Insertion behavior.
+;;-----------------------------------------------------
+
+(defun et-range (extent)
+  "List (START-POSITION END-POSITION) of EXTENT."
+  (list (extent-start-position extent)
+       (extent-end-position extent)))
+
+(defun et-insert-at (string position)
+  "Insert STRING at POSITION in the current buffer."
+  (save-excursion
+    (goto-char position)
+    (insert string)))
+
+;; Test insertion at the beginning, middle, and end of the extent.
+
+;; closed-open
+
+(with-temp-buffer
+  (insert "###eee###")
+  (let ((e (make-extent 4 7)))
+    ;; current state: "###[eee)###"
+    ;;                 123 456 789
+    (Assert (equal (et-range e) '(4 7)))
+
+    (et-insert-at "xxx" 4)
+
+    ;; current state: "###[xxxeee)###"
+    ;;                 123 456789 012
+    (Assert (equal (et-range e) '(4 10)))
+
+    (et-insert-at "yyy" 7)
+
+    ;; current state: "###[xxxyyyeee)###"
+    ;;                 123 456789012 345
+    (Assert (equal (et-range e) '(4 13)))
+
+    (et-insert-at "zzz" 13)
+
+    ;; current state: "###[xxxyyyeee)zzz###"
+    ;;                 123 456789012 345678
+    (Assert (equal (et-range e) '(4 13)))
+    ))
+
+;; closed-closed
+
+(with-temp-buffer
+  (insert "###eee###")
+  (let ((e (make-extent 4 7)))
+    (put e 'end-closed t)
+
+    ;; current state: "###[eee]###"
+    ;;                 123 456 789
+    (Assert (equal (et-range e) '(4 7)))
+
+    (et-insert-at "xxx" 4)
+
+    ;; current state: "###[xxxeee]###"
+    ;;                 123 456789 012
+    (Assert (equal (et-range e) '(4 10)))
+
+    (et-insert-at "yyy" 7)
+
+    ;; current state: "###[xxxyyyeee]###"
+    ;;                 123 456789012 345
+    (Assert (equal (et-range e) '(4 13)))
+
+    (et-insert-at "zzz" 13)
+
+    ;; current state: "###[xxxyyyeeezzz]###"
+    ;;                 123 456789012345 678
+    (Assert (equal (et-range e) '(4 16)))
+    ))
+
+;; open-closed
+
+(with-temp-buffer
+  (insert "###eee###")
+  (let ((e (make-extent 4 7)))
+    (put e 'start-open t)
+    (put e 'end-closed t)
+
+    ;; current state: "###(eee]###"
+    ;;                 123 456 789
+    (Assert (equal (et-range e) '(4 7)))
+
+    (et-insert-at "xxx" 4)
+
+    ;; current state: "###xxx(eee]###"
+    ;;                 123456 789 012
+    (Assert (equal (et-range e) '(7 10)))
+
+    (et-insert-at "yyy" 8)
+
+    ;; current state: "###xxx(eyyyee]###"
+    ;;                 123456 789012 345
+    (Assert (equal (et-range e) '(7 13)))
+
+    (et-insert-at "zzz" 13)
+
+    ;; current state: "###xxx(eyyyeezzz]###"
+    ;;                 123456 789012345 678
+    (Assert (equal (et-range e) '(7 16)))
+    ))
+
+;; open-open
+
+(with-temp-buffer
+  (insert "###eee###")
+  (let ((e (make-extent 4 7)))
+    (put e 'start-open t)
+
+    ;; current state: "###(eee)###"
+    ;;                 123 456 789
+    (Assert (equal (et-range e) '(4 7)))
+
+    (et-insert-at "xxx" 4)
+
+    ;; current state: "###xxx(eee)###"
+    ;;                 123456 789 012
+    (Assert (equal (et-range e) '(7 10)))
+
+    (et-insert-at "yyy" 8)
+
+    ;; current state: "###xxx(eyyyee)###"
+    ;;                 123456 789012 345
+    (Assert (equal (et-range e) '(7 13)))
+
+    (et-insert-at "zzz" 13)
+
+    ;; current state: "###xxx(eyyyee)zzz###"
+    ;;                 123456 789012 345678
+    (Assert (equal (et-range e) '(7 13)))
+    ))
+
+
+;;-----------------------------------------------------
+;; Deletion behavior.
+;;-----------------------------------------------------
+
+(dolist (props '((start-closed t end-open t)
+                (start-closed t end-open nil)
+                (start-closed nil end-open nil)
+                (start-closed nil end-open t)))
+  ;; Deletion needs to behave the same regardless of the open-ness of
+  ;; the boundaries.
+
+  (with-temp-buffer
+    (insert "xxxxxxxxxx")
+    (let ((e (make-extent 3 9)))
+      (set-extent-properties e props)
+
+      ;; current state: xx[xxxxxx]xx
+      ;;                12 345678 90
+      (Assert (equal (et-range e) '(3 9)))
+
+      (delete-region 1 2)
+
+      ;; current state: x[xxxxxx]xx
+      ;;                1 234567 89
+      (Assert (equal (et-range e) '(2 8)))
+
+      (delete-region 2 4)
+
+      ;; current state: x[xxxx]xx
+      ;;                1 2345 67
+      (Assert (equal (et-range e) '(2 6)))
+
+      (delete-region 1 3)
+
+      ;; current state: [xxx]xx
+      ;;                 123 45
+      (Assert (equal (et-range e) '(1 4)))
+
+      (delete-region 3 5)
+
+      ;; current state: [xx]x
+      ;;                 12 3
+      (Assert (equal (et-range e) '(1 3)))
+
+      )))
+
+;;; #### Should have a test for read-only-ness and insertion and
+;;; deletion!
+
+;;-----------------------------------------------------
+;; `detachable' property
+;;-----------------------------------------------------
+
+(dolist (props '((start-closed t end-open t)
+                (start-closed t end-open nil)
+                (start-closed nil end-open nil)
+                (start-closed nil end-open t)))
+  ;; `detachable' shouldn't relate to region properties, hence the
+  ;; loop.
+  (with-temp-buffer
+    (insert "###eee###")
+    (let ((e (make-extent 4 7)))
+      (set-extent-properties e props)
+      (Assert (get e 'detachable))
+
+      (Assert (not (extent-detached-p e)))
+
+      (delete-region 4 5)
+      ;; ###ee### (not detached yet)
+      (Assert (not (extent-detached-p e)))
+
+      (delete-region 4 6)
+      ;; ###### (should be detached now)
+      (Assert (extent-detached-p e))))
+
+  (with-temp-buffer
+    (insert "###eee###")
+    (let ((e (make-extent 4 7)))
+      (set-extent-properties e props)
+      (put e 'detachable nil)
+      (Assert (not (get e 'detachable)))
+    
+      (Assert (not (extent-detached-p e)))
+
+      (delete-region 4 5)
+      ;; ###ee###
+      (Assert (not (extent-detached-p e)))
+
+      (delete-region 4 6)
+      ;; ###[]###
+      (Assert (not (extent-detached-p e)))
+      (Assert (equal (et-range e) '(4 4)))
+      ))
+  )
+
+
+;;-----------------------------------------------------
+;; Zero-length extents.
+;;-----------------------------------------------------
+
+;; closed-open (should stay put)
+(with-temp-buffer
+  (insert "######")
+  (let ((e (make-extent 4 4)))
+    (et-insert-at "foo" 4)
+    (Assert (equal (et-range e) '(4 4)))))
+
+;; open-closed (should move)
+(with-temp-buffer
+  (insert "######")
+  (let ((e (make-extent 4 4)))
+    (put e 'start-open t)
+    (put e 'end-closed t)
+    (et-insert-at "foo" 4)
+    (Assert (equal (et-range e) '(7 7)))))
+
+;; closed-closed (should extend)
+(with-temp-buffer
+  (insert "######")
+  (let ((e (make-extent 4 4)))
+    (put e 'end-closed t)
+    (et-insert-at "foo" 4)
+    (Assert (equal (et-range e) '(4 7)))))
+
+;; open-open (illegal; forced to behave like closed-open)
+(with-temp-buffer
+  (insert "######")
+  (let ((e (make-extent 4 4)))
+    (put e 'start-open t)
+    (et-insert-at "foo" 4)
+    (Assert (equal (et-range e) '(4 4)))))