From: Mark H Weaver <mhw@netris.org>
Date: Tue, 16 Jul 2013 04:26:11 +0000 (-0400)
Subject: Avoid lossy conversion from inum to double in numerical comparisons.
X-Git-Url: http://git.hcoop.net/bpt/guile.git/commitdiff_plain/95ed221785f5b1203e998823455f682c1830498b

Avoid lossy conversion from inum to double in numerical comparisons.

* libguile/numbers.c (scm_less_p): Avoid converting inums to doubles.

* test-suite/tests/numbers.test (<): Add tests.
---

diff --git a/libguile/numbers.c b/libguile/numbers.c
index 458a92f1c..d09b7c575 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -6767,7 +6767,25 @@ scm_less_p (SCM x, SCM y)
 	  return scm_from_bool (sgn > 0);
 	}
       else if (SCM_REALP (y))
-	return scm_from_bool ((double) xx < SCM_REAL_VALUE (y));
+        {
+          /* We can safely take the ceiling of y without changing the
+             result of x<y, given that x is an integer. */
+          double yy = ceil (SCM_REAL_VALUE (y));
+
+          /* In the following comparisons, it's important that the right
+             hand side always be a power of 2, so that it can be
+             losslessly converted to a double even on 64-bit
+             machines. */
+          if (yy >= (double) (SCM_MOST_POSITIVE_FIXNUM+1))
+            return SCM_BOOL_T;
+          else if (!(yy > (double) SCM_MOST_NEGATIVE_FIXNUM))
+            /* The condition above is carefully written to include the
+               case where yy==NaN. */
+            return SCM_BOOL_F;
+          else
+            /* yy is a finite integer that fits in an inum. */
+            return scm_from_bool (xx < (scm_t_inum) yy);
+        }
       else if (SCM_FRACTIONP (y))
         {
           /* "x < a/b" becomes "x*b < a" */
@@ -6810,7 +6828,25 @@ scm_less_p (SCM x, SCM y)
   else if (SCM_REALP (x))
     {
       if (SCM_I_INUMP (y))
-	return scm_from_bool (SCM_REAL_VALUE (x) < (double) SCM_I_INUM (y));
+        {
+          /* We can safely take the floor of x without changing the
+             result of x<y, given that y is an integer. */
+          double xx = floor (SCM_REAL_VALUE (x));
+
+          /* In the following comparisons, it's important that the right
+             hand side always be a power of 2, so that it can be
+             losslessly converted to a double even on 64-bit
+             machines. */
+          if (xx < (double) SCM_MOST_NEGATIVE_FIXNUM)
+            return SCM_BOOL_T;
+          else if (!(xx < (double) (SCM_MOST_POSITIVE_FIXNUM+1)))
+            /* The condition above is carefully written to include the
+               case where xx==NaN. */
+            return SCM_BOOL_F;
+          else
+            /* xx is a finite integer that fits in an inum. */
+            return scm_from_bool ((scm_t_inum) xx < SCM_I_INUM (y));
+        }
       else if (SCM_BIGP (y))
 	{
 	  int cmp;
diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index 9a030197e..5e95ab9b6 100644
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -2135,6 +2135,9 @@
 
     (pass-if "n = fixnum-min - 1"
       (not (< 0.0 (- fixnum-min 1)))))
+
+  (pass-if (not (< -0.0 0.0)))
+  (pass-if (not (< -0.0 -0.0)))
   
   (with-test-prefix "(< 1 n)"
     
@@ -2460,6 +2463,42 @@
       (pass-if (eq? #f (< x (* -4/3 x))))
       (pass-if (eq? #f (< (- x) (* -4/3 x))))))
 
+  (with-test-prefix "inum/flonum"
+    (pass-if (< 4 4.5))
+    (pass-if (< 4.5 5))
+    (pass-if (< -5 -4.5))
+    (pass-if (< -4.5 4))
+    (pass-if (not (< 4.5 4)))
+    (pass-if (not (< 5 4.5)))
+    (pass-if (not (< -4.5 -5)))
+    (pass-if (not (< 4 -4.5)))
+
+    (pass-if (< 4 +inf.0))
+    (pass-if (< -4 +inf.0))
+    (pass-if (< -inf.0 4))
+    (pass-if (< -inf.0 -4))
+    (pass-if (not (< +inf.0 4)))
+    (pass-if (not (< +inf.0 -4)))
+    (pass-if (not (< 4 -inf.0)))
+    (pass-if (not (< -4 -inf.0)))
+
+    (pass-if (not (< +nan.0 4)))
+    (pass-if (not (< +nan.0 -4)))
+    (pass-if (not (< 4 +nan.0)))
+    (pass-if (not (< -4 +nan.0)))
+
+    (pass-if (< most-positive-fixnum (expt 2.0 fixnum-bit)))
+    (pass-if (not (< (expt 2.0 fixnum-bit) most-positive-fixnum)))
+
+    (pass-if (< (- (expt 2.0 fixnum-bit)) most-negative-fixnum))
+    (pass-if (not (< most-negative-fixnum (- (expt 2.0 fixnum-bit)))))
+
+    ;; Prior to guile 2.0.10, we would unconditionally convert the inum
+    ;; to a double, which on a 64-bit system could result in a
+    ;; significant change in its value, thus corrupting the comparison.
+    (pass-if (< most-positive-fixnum (exact->inexact most-positive-fixnum)))
+    (pass-if (< (exact->inexact (- most-positive-fixnum)) (- most-positive-fixnum))))
+
   (with-test-prefix "flonum/frac"
     (pass-if (< 0.75 4/3))
     (pass-if (< -0.75 4/3))