From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 17 Feb 2008 13:26:15 +0000 (+0000)
Subject: 1.0.14.32: fix bug 407
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b4c650bad5478d99132fdf0e219d63cf07d0a5f8;p=sbcl.git

1.0.14.32: fix bug 407

 * %SINGLE-FLOAT and %DOUBLE-FLOAT should not be flushable.

 * BUGS entry remains: should (COERCE (EXPT 2 1024) 'SINGLE-FLOAT)
   really signal a TYPE-ERROR?
---

diff --git a/BUGS b/BUGS
index 887ffbe..4c64490 100644
--- a/BUGS
+++ b/BUGS
@@ -1713,6 +1713,10 @@ WORKAROUND:
 		3: (SB-C::BOUND-FUNC ...)
 		4: (SB-C::%SINGLE-FLOAT-DERIVE-TYPE-AUX ...)
 
+  These are now fixed, but (COERCE HUGE 'SINGLE-FLOAT) still signals a
+  type-error at runtime. The question is, should it instead signal a
+  floating-point overflow, or return an infinity?
+
 408: SUBTYPEP confusion re. OR of SATISFIES of not-yet-defined predicate
 	As reported by Levente M\'{e}sz\'{a}ros sbcl-devel 2006-02-20,
 		(aver (equal (multiple-value-list
diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index a4672e5..b05138a 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -15,8 +15,8 @@
 
 ;;;; coercions
 
-(defknown %single-float (real) single-float (movable foldable flushable))
-(defknown %double-float (real) double-float (movable foldable flushable))
+(defknown %single-float (real) single-float (movable foldable))
+(defknown %double-float (real) double-float (movable foldable))
 
 (deftransform float ((n f) (* single-float) *)
   '(%single-float n))
@@ -286,7 +286,10 @@
                 (specifier-type `(,',type ,(or lo '*) ,(or hi '*)))))
 
             (defoptimizer (,fun derive-type) ((num))
-              (one-arg-derive-type num #',aux-name #',fun))))))
+              (handler-case
+                  (one-arg-derive-type num #',aux-name #',fun)
+                (type-error ()
+                  nil)))))))
   (frob %single-float single-float
         most-negative-single-float most-positive-single-float)
   (frob %double-float double-float
diff --git a/tests/float.impure.lisp b/tests/float.impure.lisp
index 04609a4..aad98f5 100644
--- a/tests/float.impure.lisp
+++ b/tests/float.impure.lisp
@@ -119,3 +119,22 @@
 (defun new-pu-label-from-pu-labels (array)
   (setf (aref (the myarraytype array) 0)
         sb-ext:double-float-positive-infinity))
+
+;;; bug 407
+;;;
+;;; FIXME: it may be that TYPE-ERROR is wrong, and we should
+;;; instead signal an overflow or coerce into an infinity.
+(defun bug-407a ()
+  (loop for n from (expt 2 1024) upto (+ 10 (expt 2 1024))
+        do (handler-case
+               (coerce n 'single-float)
+             (simple-type-error ()
+               (return-from bug-407a :type-error)))))
+(assert (eq :type-error (bug-407a)))
+(defun bug-407b ()
+  (loop for n from (expt 2 1024) upto (+ 10 (expt 2 1024))
+        do (handler-case
+               (format t "~E~%" (coerce n 'single-float))
+             (simple-type-error ()
+               (return-from bug-407b :type-error)))))
+(assert (eq :type-error (bug-407b)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 47934f2..1690451 100644
--- 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.14.31"
+"1.0.14.32"