X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ffloat.impure.lisp;h=aad98f59a35edc54c85b9f0dab537d134fb40758;hb=96bb2dc76dddb1a21b3886fa7522796879e9ed9d;hp=04609a48cc23f429e17818fd3e902874f46fa90c;hpb=b3e3fbe7d381147fccc8a3027cb6fae923e57d13;p=sbcl.git

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)))