diff options
| -rw-r--r-- | libguile/numbers.c | 40 | ||||
| -rw-r--r-- | test-suite/tests/numbers.test | 39 |
2 files changed, 77 insertions, 2 deletions
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)) |