fix treatment of signed zeroes in INTERVAL-DIV

 Fixes bug reported by Eric Marsden on sbcl-devel: type derivation going wrong
 due to one signed zeroes: (/ 0.0 -neg) derives correctly as -0.0, but (/ 0
 -neg) derives as 0.0, causing the intersection to be empty causing badness.

 Simply remove special casing of division of zero from INTERVAL-DIV:
 BOUND-BINOP handles signed zeroes correctly, so no sense complicating the
 code by adding handling for them in I-D.

diff --git a/NEWS b/NEWS
index 122a0ea..8790dd1 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -9,6 +9,8 @@ changes relative to sbcl-1.0.54:
        full-blows cross-compilation.)
   * bug fix: deadlock detection could report the same deadlock twice, for
     two different threads. Now a single deadlock is reported exactly once.
+  * bug fix: interval-arithmetic division during type derivation did not
+    account for signed zeros.
 
 changes in sbcl-1.0.54 relative to sbcl-1.0.53:
   * minor incompatible changes:

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index cc7cb91..a43f1db 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -853,9 +853,6 @@
                  ((zerop (type-bound-number y))
                   ;; Divide by zero means result is infinity
                   nil)
-                 ((and (numberp x) (zerop x))
-                  ;; Zero divided by anything is zero.
-                  x)
                  (t
                   (bound-binop / x y)))))
     (let ((top-range (interval-range-info top))

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 1a81296..a8d0eea 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4080,3 +4080,12 @@
                                        (throw 'out (lambda () t))))
                                 (foo))))))))
     (assert (equal '(lambda () :in foo) (sb-kernel:%fun-name fun)))))
+
+(with-test (:name :interval-div-signed-zero)
+  (let ((fun (compile nil
+                      `(Lambda (a)
+                         (declare (type (member 0 -272413371076) a))
+                         (ffloor (the number a) -63243.127451934015d0)))))
+    (multiple-value-bind (q r) (funcall fun 0)
+      (assert (eql -0d0 q))
+      (assert (eql 0d0 r)))))