1.0.18.4: use CAREFUL-SPECIFIER-TYPE when deriving the type COERCE

 * Derived type of the second argument can eg. be a MEMBER type with
   where all members are not valid type specifiers: this is a runtime
   error, not a compile-time one.

diff --git a/NEWS b/NEWS
index 098042c..7305f0a 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -7,6 +7,9 @@ changes in sbcl-1.0.19 relative to 1.0.18:
        to single-float coercions.
     ** artihmetic operations involving large integers and single
        floats give the same results in compiled and interpreted code.
+    ** deriving the result type of COERCE no longer signals an error
+       if the derived type of the second argument is a MEMBER type
+       containing invalid type specifiers.
 
 changes in sbcl-1.0.18 relative to 1.0.17:
   * minor incompatible change: SB-SPROF:WITH-PROFILING now by default

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 764e617..231ce84 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -3990,7 +3990,7 @@
                           (eq (first (second good-cons-type)) 'member))
                      `(,(second (second good-cons-type))
                        ,@(unconsify-type (caddr good-cons-type))))))
-            (coerceable-p (c-type)
+            (coerceable-p (part)
               ;; Can the value be coerced to the given type?  Coerce is
               ;; complicated, so we don't handle every possible case
               ;; here---just the most common and easiest cases:
@@ -4012,13 +4012,14 @@
               ;; the requested type, because (by assumption) COMPLEX
               ;; (and other difficult types like (COMPLEX INTEGER)
               ;; aren't specialized types.
-              (let ((coerced-type c-type))
-                (or (and (subtypep coerced-type 'float)
-                         (csubtypep value-type (specifier-type 'real)))
-                    (and (subtypep coerced-type
-                                   '(or (complex single-float)
-                                        (complex double-float)))
-                         (csubtypep value-type (specifier-type 'number))))))
+              (let ((coerced-type (careful-specifier-type part)))
+                (when coerced-type
+                  (or (and (csubtypep coerced-type (specifier-type 'float))
+                           (csubtypep value-type (specifier-type 'real)))
+                      (and (csubtypep coerced-type
+                                      (specifier-type `(or (complex single-float)
+                                                           (complex double-float))))
+                          (csubtypep value-type (specifier-type 'number)))))))
             (process-types (type)
               ;; FIXME: This needs some work because we should be able
               ;; to derive the resulting type better than just the

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index b261254..af716d5 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2546,3 +2546,27 @@
               (+ 81535869 (the (member 17549.955 #:g35917) p2))))
            17549.955)
           (+ 81535869 17549.955)))
+
+;;; misc.654
+(assert (eql 2
+             (let ((form '(lambda (p2)
+                           (declare (optimize (speed 0) (safety 2) (debug 0) (space 2))
+                            (type (member integer eql) p2))
+                           (coerce 2 p2))))
+               (funcall (compile nil form) 'integer))))
+
+;;; misc.656
+(assert (eql 2
+             (let ((form '(lambda (p2)
+                           (declare (optimize (speed 0) (safety 2) (debug 0) (space 2))
+                            (type (member integer mod) p2))
+                           (coerce 2 p2))))
+               (funcall (compile nil form) 'integer))))
+
+;;; misc.657
+(assert (eql 2
+         (let ((form '(lambda (p2)
+                       (declare (optimize (speed 0) (safety 2) (debug 0) (space 2))
+                        (type (member integer values) p2))
+                       (coerce 2 p2))))
+           (funcall (compile nil form) 'integer))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 2228b13..4a42341 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.18.3"
+"1.0.18.4"