From a7b24b560fe52cedbbe831b642c5636447156fcf Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Sun, 14 Aug 2011 17:28:22 -0400 Subject: [PATCH] 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. --- NEWS | 2 ++ src/compiler/float-tran.lisp | 12 ++++-------- src/compiler/srctran.lisp | 23 ++++++++++++++--------- tests/compiler.pure.lisp | 13 +++++++++++++ 4 files changed, 33 insertions(+), 17 deletions(-) diff --git a/NEWS b/NEWS index c41f93f..3949270 100644 --- 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 --- 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 --- 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 --- 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))))))))) -- 1.7.10.4