0.8.16.16:

[sbcl.git] / src / code / coerce.lisp

diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index 1d05f63..575083f 100644 (file)
--- 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