X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcoerce.lisp;h=575083f15371e1279e9d9ecd7f7cc4697e845f25;hb=988afd9d54ba6c8a915544822658824ab6ae0d6c;hp=1d05f63ac2502cf3b2e17919ec9fe35bf5b1d452;hpb=4ff8421d6f4590024f82ea6f6851e25b4ca3df99;p=sbcl.git

diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index 1d05f63..575083f 100644
--- a/src/code/coerce.lisp
+++ b/src/code/coerce.lisp
@@ -116,7 +116,6 @@
 	((csubtypep type (specifier-type 'character))
 	 (character object))
 	((csubtypep type (specifier-type 'function))
-	 #!+high-security
 	 (when (and (legal-fun-name-p object)
 		    (not (fboundp object)))
 	   (error 'simple-type-error
@@ -129,7 +128,6 @@
 		  :expected-type '(satisfies fboundp)
 	       :format-control "~S isn't fbound."
 	       :format-arguments (list object)))
-	 #!+high-security
 	 (when (and (symbolp object)
 		    (sb!xc:macro-function object))
 	   (error 'simple-type-error
@@ -137,7 +135,6 @@
 		  :expected-type '(not (satisfies sb!xc:macro-function))
 		  :format-control "~S is a macro."
 		  :format-arguments (list object)))
-	 #!+high-security
 	 (when (and (symbolp object)
 		    (special-operator-p object))
 	   (error 'simple-type-error
@@ -206,18 +203,25 @@
 	      res))))
 	((csubtypep type (specifier-type 'list))
 	 (if (vectorp object)
-	     (cond ((type= type (specifier-type 'list))
-		    (vector-to-list* object))
-		   ((type= type (specifier-type 'null))
-		    (if (= (length object) 0)
-			'nil
-			(sequence-type-length-mismatch-error type
-							     (length object))))
-		   ((csubtypep (specifier-type '(cons nil t)) type)
-		    (if (> (length object) 0)
-			(vector-to-list* object)
-			(sequence-type-length-mismatch-error type 0)))
-		   (t (sequence-type-too-hairy (type-specifier type))))
+	     (cond
+	       ((type= type (specifier-type 'list))
+		(vector-to-list* object))
+	       ((type= type (specifier-type 'null))
+		(if (= (length object) 0)
+		    'nil
+		    (sequence-type-length-mismatch-error type
+							 (length object))))
+	       ((cons-type-p type)
+		(multiple-value-bind (min exactp)
+		    (sb!kernel::cons-type-length-info type)
+		  (let ((length (length object)))
+		    (if exactp
+			(unless (= length min)
+			  (sequence-type-length-mismatch-error type length))
+			(unless (>= length min)
+			  (sequence-type-length-mismatch-error type length)))
+		    (vector-to-list* object))))
+	       (t (sequence-type-too-hairy (type-specifier type))))
 	     (coerce-error)))
 	((csubtypep type (specifier-type 'vector))
 	 (typecase object