X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fseq.impure.lisp;h=f6e79d325da5fcc0a926e39da273c2ae7d1d81be;hb=87cd7d9848d9beddbf74e9d56a0c0aea6e189ead;hp=2145c2d58cbcffe3ed52a14780773a3500882e02;hpb=1596e9fdeb2265c4a00e441bc8a1dbdc5364afa7;p=sbcl.git

diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp
index 2145c2d..f6e79d3 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
@@ -1080,5 +1083,21 @@
 
 (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)))
+  (fill l 0 :start 1 :end 2)
+  (assert (equal l '(1 0 3)))
+  (fill l 'x :start 2 :end 3)
+  (assert (equal l '(1 0 x)))
+  (fill l 'y :start 1)
+  (assert (equal l '(1 y y)))
+  (fill l 'z :end 2)
+  (assert (equal l '(z z y)))
+  (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