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

Merge branch 'master' of github.com:ashinn/chibi-scheme

Browse source
This commit is contained in:
Alex Shinn 2020-07-13 10:02:11 +09:00
commit 9940e0d053
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))