From eb9d632dbf9105264e66ea61a2047f430b62099f Mon Sep 17 00:00:00 2001 From: Kris Katterjohn Date: Fri, 10 Jul 2020 16:49:56 -0400 Subject: [PATCH] Fix some NaN comparisons: NaNs are not less than every fixnum (< +nan.0 n) was yielding #t for fixnum n, and similarly for (<= +nan.0 n) and (> n +nan.0) and so on. This also caused (negative? +nan.0) to return #t. It just happened that NaNs were less than all fixnums: if a conditional was written the other way around then NaNs would have been greater than all fixnums instead. The flonum case was sort of "accidentally" correct, but if a conditional was written the other way around then NaNs would be both less than or equal to and greater than all or equal to all flonums (but still not equal). For both cases check for NaNs after getting the flonum values. --- bignum.c | 12 ++++++++++-- tests/r7rs-tests.scm | 6 ++++++ 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/bignum.c b/bignum.c index 9eac5b26..a1360d8a 100644 --- a/bignum.c +++ b/bignum.c @@ -1833,7 +1833,10 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) { case SEXP_NUM_FIX_FLO: f = sexp_fixnum_to_double(a); g = sexp_flonum_value(b); - r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1); + if (isnan(g)) + r = sexp_xtype_exception(ctx, NULL, "can't compare NaN", b); + else + r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1); break; case SEXP_NUM_FIX_BIG: if ((sexp_bignum_hi(b) > 1) || @@ -1845,7 +1848,12 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) { case SEXP_NUM_FLO_FLO: f = sexp_flonum_value(a); g = sexp_flonum_value(b); - r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1); + if (isnan(f)) + r = sexp_xtype_exception(ctx, NULL, "can't compare NaN", a); + else if (isnan(g)) + r = sexp_xtype_exception(ctx, NULL, "can't compare NaN", b); + else + r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1); break; case SEXP_NUM_FLO_BIG: f = sexp_flonum_value(a); diff --git a/tests/r7rs-tests.scm b/tests/r7rs-tests.scm index 2a7d9969..638ad115 100644 --- a/tests/r7rs-tests.scm +++ b/tests/r7rs-tests.scm @@ -793,6 +793,10 @@ (test #f (<= 1 2 1)) (test #t (>= 2 1 1)) (test #f (>= 1 2 1)) +(test #f (< +nan.0 0)) +(test #f (> +nan.0 0)) +(test #f (< +nan.0 0.0)) +(test #f (> +nan.0 0.0)) (test '(#t #f) (list (<= 1 1 2) (<= 2 1 3))) ;; From R7RS 6.2.6 Numerical operations: @@ -843,6 +847,7 @@ (test #f (positive? -1.0)) (test #t (positive? +inf.0)) (test #f (positive? -inf.0)) +(test #f (positive? +nan.0)) (test #f (negative? 0)) (test #f (negative? 0.0)) @@ -852,6 +857,7 @@ (test #t (negative? -1.0)) (test #f (negative? +inf.0)) (test #t (negative? -inf.0)) +(test #f (negative? +nan.0)) (test #f (odd? 0)) (test #t (odd? 1))