From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Fri, 19 Aug 2005 21:18:47 +0000 (+0000)
Subject: 0.9.3.68:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=5185db40031bedaa9dcfa8ba72cbbc8079e51e81;p=sbcl.git

0.9.3.68:
	Fix a bug introduced in 0.9.3.44 (reported by James Y Knight
	sbcl-devel 2005-08-19)
	... when a bound is more extreme than
		most-frobtive-fooble-float, make an open bound;
	... when both thingies are of the same type of float,
		safely-binop can proceed regardless (as float-traps
		are masked).
	... James Y Knight's test case.
---

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 785749f..92251da 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -2026,13 +2026,11 @@ used for a COMPLEX component.~:@>"
                     ((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)))
+                         nil))
                     (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))))))
+                         nil)))))
              (if (consp x) (list res) res)))))
       nil))
 
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index f5e4293..d2e3028 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -317,10 +317,12 @@
 (defmacro safely-binop (op x y)
   `(cond
     ((typep ,x 'single-float)
-     (if (<= most-negative-single-float ,y most-positive-single-float)
+     (if (or (typep ,y 'single-float)
+             (<= most-negative-single-float ,y most-positive-single-float))
          (,op ,x ,y)))
     ((typep ,x 'double-float)
-     (if (<= most-negative-double-float ,y most-positive-double-float)
+     (if (or (typep ,y 'double-float)
+             (<= most-negative-double-float ,y most-positive-double-float))
          (,op ,x ,y)))
     ((typep ,y 'single-float)
      (if (<= most-negative-single-float ,x most-positive-single-float)
diff --git a/tests/float.impure.lisp b/tests/float.impure.lisp
index e32a6d9..baf2c0f 100644
--- a/tests/float.impure.lisp
+++ b/tests/float.impure.lisp
@@ -114,5 +114,11 @@
 
 (assert (= (test 1.0d0) 2.0d0))
 
+(deftype myarraytype (&optional (length '*)) 
+  `(simple-array double-float (,length)))
+(defun new-pu-label-from-pu-labels (array)
+  (setf (aref (the myarraytype array) 0) 
+        sb-ext:double-float-positive-infinity))
+
 ;;; success
 (quit :unix-status 104)
diff --git a/version.lisp-expr b/version.lisp-expr
index 9e66a36..4b91345 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".)
-"0.9.3.67"
+"0.9.3.68"