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

8
bignum.c
View file

@ -1833,6 +1833,9 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) {
case SEXP_NUM_FIX_FLO: case SEXP_NUM_FIX_FLO:
f = sexp_fixnum_to_double(a); f = sexp_fixnum_to_double(a);
g = sexp_flonum_value(b); g = sexp_flonum_value(b);
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); r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1);
break; break;
case SEXP_NUM_FIX_BIG: case SEXP_NUM_FIX_BIG:
@ -1845,6 +1848,11 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) {
case SEXP_NUM_FLO_FLO: case SEXP_NUM_FLO_FLO:
f = sexp_flonum_value(a); f = sexp_flonum_value(a);
g = sexp_flonum_value(b); g = sexp_flonum_value(b);
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); r = sexp_make_fixnum(f < g ? -1 : f == g ? 0 : 1);
break; break;
case SEXP_NUM_FLO_BIG: case SEXP_NUM_FLO_BIG:

6
tests/r7rs-tests.scm
View file

@ -793,6 +793,10 @@
(test #f (<= 1 2 1)) (test #f (<= 1 2 1))
(test #t (>= 2 1 1)) (test #t (>= 2 1 1))
(test #f (>= 1 2 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))) (test '(#t #f) (list (<= 1 1 2) (<= 2 1 3)))
;; From R7RS 6.2.6 Numerical operations: ;; From R7RS 6.2.6 Numerical operations:
@ -843,6 +847,7 @@
(test #f (positive? -1.0)) (test #f (positive? -1.0))
(test #t (positive? +inf.0)) (test #t (positive? +inf.0))
(test #f (positive? -inf.0)) (test #f (positive? -inf.0))
(test #f (positive? +nan.0))
(test #f (negative? 0)) (test #f (negative? 0))
(test #f (negative? 0.0)) (test #f (negative? 0.0))
@ -852,6 +857,7 @@
(test #t (negative? -1.0)) (test #t (negative? -1.0))
(test #f (negative? +inf.0)) (test #f (negative? +inf.0))
(test #t (negative? -inf.0)) (test #t (negative? -inf.0))
(test #f (negative? +nan.0))
(test #f (odd? 0)) (test #f (odd? 0))
(test #t (odd? 1)) (test #t (odd? 1))