[Sbcl-commits] CVS: sbcl/src/code late-type.lisp,1.117,1.118

[Brian M. <bma...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23793/src/code

Modified Files:
	late-type.lisp 
Log Message:
0.9.3.41: fix three MISC tests where type derivation attempted to
coerce a large bignum to a float, and hopefully fix other potential
similar problems in that area



Index: late-type.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/late-type.lisp,v
retrieving revision 1.117
retrieving revision 1.118
diff -u -d -r1.117 -r1.118
--- late-type.lisp	10 Aug 2005 15:10:18 -0000	1.117
+++ late-type.lisp	12 Aug 2005 00:59:07 -0000	1.118
@@ -2025,7 +2025,18 @@
                (if up-p (1+ cx) (1- cx))
                (if up-p (ceiling cx) (floor cx))))
           (float
-           (let ((res (if format (coerce cx format) (float cx))))
+           (let ((res
+                  (cond
+                    ((and format (subtypep format 'double-float))
+                     (if (<= most-negative-double-float cx most-positive-double-float)
+                         (coerce cx format)
+                         (if (< x most-negative-double-float)
+                             most-negative-double-float most-positive-double-float)))
+                    (t
+                     (if (<= most-negative-single-float cx most-positive-single-float)
+                         (coerce cx format)
+                         (if (< x most-negative-single-float)
+                             most-negative-single-float most-positive-single-float))))))
              (if (consp x) (list res) res)))))
       nil))