Handle SIMPLE-TYPE-ERROR when propagating bounds

 Type conversions (e.g. bignum to float) may signal a
 SIMPLE-TYPE-ERROR rather than returning an infinity.
 Treat that case like an unknown value.

 Add two tests.

 Fixes lp#819269.

diff --git a/NEWS b/NEWS
index c41f93f..3949270 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -38,6 +38,8 @@ changes relative to sbcl-1.0.50:
   * bug fix: OPEN :IF-EXISTS :APPEND now returns correct FILE-POSITION before
     first write (lp#561642).
   * bug fix: compiled closures from EVAL could not be DESCRIBEd. (lp#824974)
+  * bug fix: bound propagation involving conversion of large bignums to
+    floats no longer signals a SIMPLE-TYPE-ERROR (lp#819269).
 
 changes in sbcl-1.0.50 relative to sbcl-1.0.49:
   * enhancement: errors from FD handlers now provide a restart to remove

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index e0d6e93..bd7e427 100644 (file)
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -948,11 +948,9 @@
                    (int-hi (if hi
                                (ceiling (type-bound-number hi))
                                '*))
-                   (f-lo (if lo
-                             (bound-func #'float lo)
+                   (f-lo (or (bound-func #'float lo)
                              '*))
-                   (f-hi (if hi
-                             (bound-func #'float hi)
+                   (f-hi (or (bound-func #'float hi)
                              '*)))
               (specifier-type `(or (rational ,int-lo ,int-hi)
                                 (single-float ,f-lo, f-hi)))))
@@ -982,11 +980,9 @@
                    (int-hi (if hi
                                (ceiling (type-bound-number hi))
                                '*))
-                   (f-lo (if lo
-                             (bound-func #'float lo)
+                   (f-lo (or (bound-func #'float lo)
                              '*))
-                   (f-hi (if hi
-                             (bound-func #'float hi)
+                   (f-hi (or (bound-func #'float hi)
                              '*)))
               (specifier-type `(or (rational ,int-lo ,int-hi)
                                 (single-float ,f-lo, f-hi)))))

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 90ebeed..cc7cb91 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -350,15 +350,20 @@
 (defun bound-func (f x)
   (declare (type function f))
   (and x
-       (with-float-traps-masked (:underflow :overflow :inexact :divide-by-zero)
-         ;; With these traps masked, we might get things like infinity
-         ;; or negative infinity returned. Check for this and return
-         ;; NIL to indicate unbounded.
-         (let ((y (funcall f (type-bound-number x))))
-           (if (and (floatp y)
-                    (float-infinity-p y))
-               nil
-               (set-bound y (consp x)))))))
+       (handler-case
+         (with-float-traps-masked (:underflow :overflow :inexact :divide-by-zero)
+           ;; With these traps masked, we might get things like infinity
+           ;; or negative infinity returned. Check for this and return
+           ;; NIL to indicate unbounded.
+           (let ((y (funcall f (type-bound-number x))))
+             (if (and (floatp y)
+                      (float-infinity-p y))
+                 nil
+                 (set-bound y (consp x)))))
+         ;; Some numerical operations will signal SIMPLE-TYPE-ERROR, e.g.
+         ;; in the course of converting a bignum to a float.  Default to
+         ;; NIL in that case.
+         (simple-type-error ()))))
 
 (defun safe-double-coercion-p (x)
   (or (typep x 'double-float)

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 38640aa..0e271e1 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -3954,3 +3954,16 @@
     (multiple-value-bind (i e) (ignore-errors (funcall fun :end))
       (assert (not i))
       (assert (typep e 'type-error)))))
+
+(with-test (:name :simple-type-error-in-bound-propagation-a)
+  (compile nil `(lambda (i)
+                  (declare (unsigned-byte i))
+                  (expt 10 (expt 7 (- 2 i))))))
+
+(with-test (:name :simple-type-error-in-bound-propagation-b)
+  (assert (equal `(FUNCTION (UNSIGNED-BYTE)
+                            (VALUES (SINGLE-FLOAT -1F0 1F0) &OPTIONAL))
+                 (sb-kernel:%simple-fun-type
+                  (compile nil `(lambda (i)
+                                  (declare (unsigned-byte i))
+                                  (cos (expt 10 (+ 4096 i)))))))))