X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fseq.impure.lisp;h=a5753520e4606a6dbec598581b9a1183da3a4744;hb=dcd86042bba514f5dfc39246de9cdbb030648569;hp=b8ee470d52f646c8ca38693958a7f33e4c51af5e;hpb=8cbd7fc0f27222a778ce61bae7d943a5081362cc;p=sbcl.git

diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp
index b8ee470..a575352 100644
--- a/tests/seq.impure.lisp
+++ b/tests/seq.impure.lisp
@@ -377,15 +377,18 @@
   (svref x 0))
 (assert (raises-error? (svrefalike #*0) type-error))
 
-;;; checks for uniform bounding index handling under SAFETY 3 code.
+;;; checks for uniform bounding index handling.
+;;;
+;;; This used to be SAFETY 3 only, but bypassing these checks with
+;;; above-zero speed when SPEED > SAFETY is not The SBCL Way.
 ;;;
 ;;; KLUDGE: not all in one big form because that causes SBCL to spend
 ;;; an absolute age trying to compile it.
 (defmacro sequence-bounding-indices-test (&body body)
   `(progn
-    (locally
+     (locally
     ;; See Issues 332 [and 333(!)] in the CLHS
-    (declare (optimize (safety 3)))
+    (declare (optimize (speed 3) (safety 1)))
     (let ((string (make-array 10
                               :fill-pointer 5
                               :initial-element #\a
@@ -401,7 +404,7 @@
           ,@(cdr body))))
     (locally
       ;; See Issues 332 [and 333(!)] in the CLHS
-      (declare (optimize (safety 3)))
+      (declare (optimize (speed 3) (safety 1)))
       (let ((string (make-array 10
                                 :fill-pointer 5
                                 :initial-element #\a
@@ -1075,4 +1078,26 @@
       (assert (test-inlined-bashing i))
       until (= i sb-vm:n-word-bits))
 
+;;; tests from the Sacla test suite via Eric Marsden, 2007-05-07
+(remove-duplicates (vector 1 2 2 1) :test-not (lambda (a b) (not (= a b))))
+
+(delete-duplicates (vector #\a #\b #\c #\a)
+                   :test-not (lambda (a b) (not (char-equal a b))))
+
+;;; FILL on lists
+(let ((l (list 1 2 3)))
+  (assert (eq l (fill l 0 :start 1 :end 2)))
+  (assert (equal l '(1 0 3)))
+  (assert (eq l (fill l 'x :start 2 :end 3)))
+  (assert (equal l '(1 0 x)))
+  (assert (eq l (fill l 'y :start 1)))
+  (assert (equal l '(1 y y)))
+  (assert (eq l (fill l 'z :end 2)))
+  (assert (equal l '(z z y)))
+  (assert (eq l (fill l 1)))
+  (assert (equal l '(1 1 1)))
+  (assert (raises-error? (fill l 0 :start 4)))
+  (assert (raises-error? (fill l 0 :end 4)))
+  (assert (raises-error? (fill l 0 :start 2 :end 1))))
+
 ;;; success