mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00
Code Activity

Avoid lossy conversion from inum to double in numerical comparisons.

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

* test-suite/tests/numbers.test (<): Add tests.
This commit is contained in:
Mark H Weaver 2013-07-16 00:26:11 -04:00
parent ba0e46ea1b
commit 95ed221785
2 changed files with 77 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

40
libguile/numbers.c
View file

@ -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;

39
test-suite/tests/numbers.test
View file

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