X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fseq.impure.lisp;h=0d3269bc4cf78877150627a5546a56ab98d22000;hb=1479483c5f40fc470053da0fc5cd8e42fc77676e;hp=52b8b1321a81562f172b171067fe633a14d6543c;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp
index 52b8b13..0d3269b 100644
--- a/tests/seq.impure.lisp
+++ b/tests/seq.impure.lisp
@@ -242,13 +242,15 @@
                    (coerce #(0 0 0 1 1 1) `(,@type-stub 6))))
     (assert-type-error (concatenate `(,@type-stub 5) #(0 0 0) #*111))
     ;; MERGE
-    (assert (= (length (merge `(,@type-stub) #(0 1 0) #*111 #'>)) 6))
-    (assert (equalp (merge `(,@type-stub) #(0 1 0) #*111 #'>)
-                   (coerce #(1 1 1 0 1 0) `(,@type-stub))))
-    (assert (= (length (merge `(,@type-stub 6) #(0 1 0) #*111 #'>)) 6))
-    (assert (equalp (merge `(,@type-stub 6) #(0 1 0) #*111 #'>)
-                   (coerce #(1 1 1 0 1 0) `(,@type-stub 6))))
-    (assert-type-error (merge `(,@type-stub 4) #(0 1 0) #*111 #'>))
+    (macrolet ((test (type)
+                 `(merge ,type (copy-seq #(0 1 0)) (copy-seq #*111) #'>)))
+      (assert (= (length (test `(,@type-stub))) 6))
+      (assert (equalp (test `(,@type-stub))
+                      (coerce #(1 1 1 0 1 0) `(,@type-stub))))
+      (assert (= (length (test `(,@type-stub 6))) 6))
+      (assert (equalp (test `(,@type-stub 6))
+                      (coerce #(1 1 1 0 1 0) `(,@type-stub 6))))
+      (assert-type-error (test `(,@type-stub 4))))
     ;; MAP
     (assert (= (length (map `(,@type-stub) #'logxor #(0 0 1 1) '(0 1 0 1))) 4))
     (assert (equalp (map `(,@type-stub) #'logxor #(0 0 1 1) '(0 1 0 1))
@@ -274,7 +276,7 @@
     (assert (equalp #(11 13)
                     (map '(simple-array fixnum (*)) #'+ '(1 2 3) '(10 11))))
     (assert-type-error (coerce '(1 2 3) 'simple-array))
-    (assert-type-error (merge 'simple-array '(1 3) '(2 4) '<))
+    (assert-type-error (merge 'simple-array (list 1 3) (list 2 4) '<))
     (assert (equalp #(3 2 1) (coerce '(3 2 1) '(vector fixnum))))
     (assert-type-error (map 'array #'identity '(1 2 3)))
     (assert-type-error (map '(array fixnum) #'identity '(1 2 3)))
@@ -287,9 +289,9 @@
 ;;; As pointed out by Raymond Toy on #lisp IRC, MERGE had some issues
 ;;; with user-defined types until sbcl-0.7.8.11
 (deftype list-typeoid () 'list)
-(assert (equal '(1 2 3 4) (merge 'list-typeoid '(1 3) '(2 4) '<)))
+(assert (equal '(1 2 3 4) (merge 'list-typeoid (list 1 3) (list 2 4) '<)))
 ;;; and also with types that weren't precicely LIST
-(assert (equal '(1 2 3 4) (merge 'cons '(1 3) '(2 4) '<)))
+(assert (equal '(1 2 3 4) (merge 'cons (list 1 3) (list 2 4) '<)))
 
 ;;; but wait, there's more! The NULL and CONS types also have implicit
 ;;; length requirements:
@@ -322,12 +324,14 @@
     (assert (= (length (coerce #(1) '(cons t null))) 1))
     (assert-type-error (coerce #() 'nil))
     ;; MERGE
-    (assert-type-error (merge 'null '(1 3) '(2 4) '<))
+    (assert-type-error (merge 'null (list 1 3) (list 2 4) '<))
     (assert-type-error (merge 'cons () () '<))
     (assert (null (merge 'null () () '<)))
-    (assert (= (length (merge 'cons '(1 3) '(2 4) '<)) 4))
+    (assert (= (length (merge 'cons (list 1 3) (list 2 4) '<)) 4))
     (assert (= (length (merge '(cons t (cons t (cons t (cons t null))))
-                              '(1 3) '(2 4) '<)) 4))
+                              (list 1 3) (list 2 4)
+                              '<))
+               4))
     (assert-type-error (merge 'nil () () '<))
     ;; CONCATENATE
     (assert-type-error (concatenate 'null '(1) "2"))
@@ -986,6 +990,8 @@
                      bashed-dst)
              (return-from test-copy-bashing nil))))))))
 
+;; Too slow for the interpreter
+#+#.(cl:if (cl:eq sb-ext:*evaluator-mode* :compile) '(and) '(or))
 (loop for i = 1 then (* i 2) do
      ;; the bare '32' here is fairly arbitrary; '8' provides a good
      ;; range of lengths over which to fill and copy, which should tease
@@ -996,4 +1002,3 @@
      until (= i sb-vm:n-word-bits))
 
 ;;; success
-(sb-ext:quit :unix-status 104)