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

diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index f1dca41..575083f 100644
--- a/src/code/coerce.lisp
+++ b/src/code/coerce.lisp
@@ -203,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