diff tests/automated/lisp-tests.el @ 5473:ac37a5f7e5be

Merge with trunk.
author Mats Lidell <matsl@xemacs.org>
date Thu, 17 Mar 2011 23:42:59 +0100
parents 00e79bbbe48f d967d96ca043
children f2881cb841b4
line wrap: on
line diff
--- a/tests/automated/lisp-tests.el	Tue Feb 22 22:56:02 2011 +0100
+++ b/tests/automated/lisp-tests.el	Thu Mar 17 23:42:59 2011 +0100
@@ -794,18 +794,18 @@
 	 (Check-Error (malformed-list wrong-type-argument) (,fun nil 1))
 	 ,@(loop for n in '(1 2 2000)
 	     collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n))))))
-     (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))))
-
+     (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun))))
+     (test-old-funs (&rest funs)
+       `(when (and (fboundp 'old-eq) (subrp (symbol-function 'old-eq)))
+         ,@(loop for fun in funs collect `(test-fun ,fun)))))
   (test-funs member* member memq 
              assoc* assoc assq 
              rassoc* rassoc rassq 
              delete* delete delq 
              remove* remove remq 
-             old-member old-memq 
-             old-assoc old-assq 
-             old-rassoc old-rassq 
-             old-delete old-delq 
-             remassoc remassq remrassoc remrassq))
+             remassoc remassq remrassoc remrassq)
+  (test-old-funs old-member old-memq old-assoc old-assq old-rassoc old-rassq 
+                 old-delete old-delq))
 
 (let ((x '((1 . 2) 3 (4 . 5))))
   (Assert (eq (assoc  1 x) (car x)))
@@ -889,19 +889,15 @@
   (Assert (let* ((x (a)) (y (remassq   6 x))) (and (eq x y) (equal y (a)))))
   (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a)))))
   (Assert (let* ((x (a)) (y (remrassq  6 x))) (and (eq x y) (equal y (a)))))
-
   (Assert (let* ((x (a)) (y (delete     3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
   (Assert (let* ((x (a)) (y (delq       3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
-  (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
-  (Assert (let* ((x (a)) (y (old-delq   3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
-
   (Assert (let* ((x (a)) (y (delete     '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
   (Assert (let* ((x (a)) (y (delq       '(1 . 2) x))) (and      (eq x y)  (equal y (a)))))
-  (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
-  (Assert (let* ((x (a)) (y (old-delq   '(1 . 2) x))) (and      (eq x y)  (equal y (a)))))
-  )
-
-
+  (when (and (fboundp 'old-eq) (subrp (symbol-function 'old-eq)))
+    (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
+    (Assert (let* ((x (a)) (y (old-delq   '(1 . 2) x))) (and      (eq x y)  (equal y (a)))))
+    (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
+    (Assert (let* ((x (a)) (y (old-delq   3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))))
 
 (flet ((a () (list '("1" . "2") "3" '("4" . "5"))))
   (Assert (let* ((x (a)) (y (remassoc  "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
@@ -1337,6 +1333,18 @@
 (Check-Error args-out-of-range (subseq [1 2 3] -42))
 (Check-Error args-out-of-range (subseq [1 2 3] 0 42))
 
+(let ((string "hi there"))
+  (Assert (equal (substring-no-properties "123" 0) "123"))
+  (Assert (equal (substring-no-properties "1234" -3 -1) "23"))
+  (Assert (equal (substring-no-properties "hi there" 0) "hi there"))
+  (put-text-property 0 (length string) 'foo 'bar string)
+  (Assert (eq 'bar (get-text-property 0 'foo string)))
+  (Assert (not
+           (get-text-property 0 'foo (substring-no-properties "hi there" 0))))
+  (Check-Error wrong-type-argument (substring-no-properties nil 4))
+  (Check-Error wrong-type-argument (substring-no-properties "hi there" pi))
+  (Check-Error wrong-type-argument (substring-no-properties "hi there" 0.0)))
+
 ;;-----------------------------------------------------
 ;; Time-related tests
 ;;-----------------------------------------------------