Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fix some NaN comparisons: NaNs are not less than every fixnum

Browse source 
(< +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.
This commit is contained in:
Kris Katterjohn 2020-07-10 16:49:56 -04:00
parent f6eeb1c9f6
commit eb9d632dbf
2 changed files with 16 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
bignum.c
View file

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

6
tests/r7rs-tests.scm
View file

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