diff tests/automated/lisp-tests.el @ 5445:6506fcb40fcf

Merged with trunk.
author Mats Lidell <matsl@xemacs.org>
date Fri, 31 Dec 2010 00:27:29 +0100
parents 8d29f1c4bb98 f87bb35a6b94
children 89331fa1c819
line wrap: on
line diff
--- a/tests/automated/lisp-tests.el	Sun Dec 26 01:48:40 2010 +0100
+++ b/tests/automated/lisp-tests.el	Fri Dec 31 00:27:29 2010 +0100
@@ -2547,7 +2547,7 @@
 (Check-Error wrong-type-argument
              (fill "1 2 3 4 5" ?1 :start (float most-positive-fixnum)))
 (Check-Error wrong-type-argument
-             (fill #*10101010 1 :start (float most-positive-fixnum))
+             (fill #*10101010 1 :start (float most-positive-fixnum)))
 (Check-Error wrong-type-argument
              (fill '(1 2 3 4 5) 1 :end (float most-positive-fixnum)))
 (Check-Error wrong-type-argument
@@ -2667,4 +2667,125 @@
                (replace '(1 2 3 4 5) [5 4 3 2 1]
                         :end2 (1+ most-positive-fixnum))))
 
+(symbol-macrolet
+    ((list-length 2048) (vector-length 512) (string-length (* 8192 2)))
+  (let ((list
+         ;; CIRCULAR_LIST_SUSPICION_LENGTH is 1024, it's helpful if this list
+         ;; is longer than that.
+         (make-list list-length 'make-list)) 
+        (vector (make-vector vector-length 'make-vector))
+        (bit-vector (make-bit-vector vector-length 1))
+        (string (make-string string-length
+                             (or (decode-char 'ucs #x20ac) ?\xFF)))
+        (item 'cons))
+    (dolist (function '(count position find delete* remove* reduce))
+      (Check-Error args-out-of-range
+                   (funcall function item list
+                            :start (1+ list-length) :end (1+ list-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function item list
+                            :start -1 :end list-length))
+      (Check-Error args-out-of-range
+                   (funcall function item list :end (* 2 list-length)))
+      (Check-Error args-out-of-range
+                   (funcall function item vector
+                            :start (1+ vector-length) :end (1+ vector-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function item vector :start -1))
+      (Check-Error args-out-of-range
+                   (funcall function item vector :end (* 2 vector-length)))
+      (Check-Error args-out-of-range
+                   (funcall function item bit-vector
+                            :start (1+ vector-length) :end (1+ vector-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function item bit-vector :start -1))
+      (Check-Error args-out-of-range
+                   (funcall function item bit-vector :end (* 2 vector-length)))
+      (Check-Error args-out-of-range
+                   (funcall function item string
+                            :start (1+ string-length) :end (1+ string-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function item string :start -1))
+      (Check-Error args-out-of-range
+                   (funcall function item string :end (* 2 string-length))))
+    (dolist (function '(delete-duplicates remove-duplicates))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence list)
+                            :start (1+ list-length) :end (1+ list-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence list)
+                            :start -1 :end list-length))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence list)
+                            :end (* 2 list-length)))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence vector)
+                            :start (1+ vector-length) :end (1+ vector-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence vector) :start -1))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence vector)
+                            :end (* 2 vector-length)))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence bit-vector)
+                            :start (1+ vector-length) :end (1+ vector-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence bit-vector) :start -1))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence bit-vector)
+                            :end (* 2 vector-length)))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence string)
+                            :start (1+ string-length) :end (1+ string-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence string) :start -1))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence string)
+                            :end (* 2 string-length))))
+    (dolist (function '(replace mismatch search))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence list) (copy-sequence list)
+                            :start1 (1+ list-length) :end1 (1+ list-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence list) (copy-sequence list)
+                            :start1 -1 :end1 list-length))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence list) (copy-sequence list)
+                            :end1 (* 2 list-length)))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence vector)
+                            (copy-sequence vector) :start1 (1+ vector-length)
+                            :end1 (1+ vector-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence vector)
+                            (copy-sequence vector) :start1 -1))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence vector)
+                            (copy-sequence vector)
+                            :end1 (* 2 vector-length)))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence bit-vector)
+                            (copy-sequence bit-vector)
+                            :start1 (1+ vector-length)
+                            :end1 (1+ vector-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence bit-vector)
+                            (copy-sequence bit-vector) :start1 -1))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence bit-vector)
+                            (copy-sequence bit-vector)
+                            :end1 (* 2 vector-length)))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence string)
+                            (copy-sequence string)
+                            :start1 (1+ string-length)
+                            :end1 (1+ string-length)))
+      (Check-Error wrong-type-argument
+                   (funcall function (copy-sequence string)
+                            (copy-sequence string) :start1 -1))
+      (Check-Error args-out-of-range
+                   (funcall function (copy-sequence string)
+                            (copy-sequence string)
+                            :end1 (* 2 string-length))))))
+
 ;;; end of lisp-tests.el