X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fseq.impure.lisp;h=91d323117647368808a68c959cb62caec6a785d8;hb=76874d05d623e0001cfcf23d2c74f78295ba6cee;hp=b298f7872d7bc69051125799961fdd11a9c9f294;hpb=58084279740fc96c6ffcd14e86dca73b71b7c288;p=sbcl.git

diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp
index b298f78..91d3231 100644
--- a/tests/seq.impure.lisp
+++ b/tests/seq.impure.lisp
@@ -13,10 +13,12 @@
 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
 ;;;; more information.
 
-(in-package :cl-user)
-
 (load "assertoid.lisp")
-(use-package "ASSERTOID")
+
+(defpackage :seq-test
+  (:use :cl :assertoid))
+
+(in-package :seq-test)
 
 ;;; helper functions for exercising SEQUENCE code on data of many
 ;;; specialized types, and in many different optimization scenarios
@@ -299,31 +301,41 @@
     ;; MAKE-SEQUENCE
     (assert-type-error (make-sequence 'cons 0))
     (assert-type-error (make-sequence 'null 1))
+    (assert-type-error (make-sequence '(cons t null) 0))
+    (assert-type-error (make-sequence '(cons t null) 2))
     ;; KLUDGE: I'm not certain that this test actually tests for what
     ;; it should test, in that the type deriver and optimizers might
     ;; be too smart for the good of an exhaustive test system.
     ;; However, it makes me feel good.  -- CSR, 2002-10-18
     (assert (null (make-sequence 'null 0)))
     (assert (= (length (make-sequence 'cons 3)) 3))
+    (assert (= (length (make-sequence '(cons t null) 1)) 1))
     ;; and NIL is not a valid type for MAKE-SEQUENCE
     (assert-type-error (make-sequence 'nil 0))
     ;; COERCE
     (assert-type-error (coerce #(1) 'null))
     (assert-type-error (coerce #() 'cons))
+    (assert-type-error (coerce #() '(cons t null)))
+    (assert-type-error (coerce #(1 2) '(cons t null)))
     (assert (null (coerce #() 'null)))
     (assert (= (length (coerce #(1) 'cons)) 1))
+    (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 'cons () () '<))
     (assert (null (merge 'null () () '<)))
     (assert (= (length (merge 'cons '(1 3) '(2 4) '<)) 4))
+    (assert (= (length (merge '(cons t (cons t (cons t (cons t null))))
+			      '(1 3) '(2 4) '<)) 4))
     (assert-type-error (merge 'nil () () '<))
     ;; CONCATENATE
     (assert-type-error (concatenate 'null '(1) "2"))
     (assert-type-error (concatenate 'cons #() ()))
+    (assert-type-error (concatenate '(cons t null) #(1 2 3) #(4 5 6)))
     (assert (null (concatenate 'null () #())))
     (assert (= (length (concatenate 'cons #() '(1) "2 3")) 4))
+    (assert (= (length (concatenate '(cons t cons) '(1) "34")) 3))
     (assert-type-error (concatenate 'nil '(3)))
     ;; FIXME: tests for MAP to come when some brave soul implements
     ;; the analogous type checking for MAP/%MAP.
@@ -339,6 +351,12 @@
   (declare (optimize (safety 3)))
   (assert (raises-error? (elt (list 1 2 3) 3) type-error)))
 
+;;; confusion in the refactoring led to this signalling an unbound
+;;; variable, not a type error.
+(defun svrefalike (x)
+  (svref x 0))
+(assert (raises-error? (svrefalike #*0) type-error))
+
 ;;; checks for uniform bounding index handling under SAFETY 3 code.
 ;;;
 ;;; KLUDGE: not all in one big form because that causes SBCL to spend
@@ -858,4 +876,4 @@
 	    (read-char s)))))
 
 ;;; success
-(quit :unix-status 104)
+(sb-ext:quit :unix-status 104)