From e5d9ccb69f08b74f675e2fffed4ba457c6fb10fd Mon Sep 17 00:00:00 2001 From: John Croisant Date: Thu, 15 Mar 2018 02:42:26 -0500 Subject: [PATCH 1/4] Raise type error if remainder called with infinity. To prevent an infinite loop, raise a type error if the remainder procedure is called with +inf.0 or -inf.0 as either argument. --- bignum.c | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/bignum.c b/bignum.c index fd7db009..757bc5de 100644 --- a/bignum.c +++ b/bignum.c @@ -1667,8 +1667,11 @@ sexp sexp_remainder (sexp ctx, sexp a, sexp b) { #if SEXP_USE_RATIOS case SEXP_NUM_FLO_RAT: #endif - if (sexp_flonum_value(a) != trunc(sexp_flonum_value(a))) { + if (isinf(sexp_flonum_value(a)) || + sexp_flonum_value(a) != trunc(sexp_flonum_value(a))) { r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, a); + } else if (bt == SEXP_NUM_FLO && isinf(sexp_flonum_value(b))) { + r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, b); } else { tmp = sexp_bignum_normalize(sexp_double_to_bignum(ctx, sexp_flonum_value(a))); tmp = sexp_remainder(ctx, tmp, b); @@ -1691,7 +1694,8 @@ sexp sexp_remainder (sexp ctx, sexp a, sexp b) { #if SEXP_USE_RATIOS case SEXP_NUM_RAT_FLO: #endif - if (sexp_flonum_value(b) != trunc(sexp_flonum_value(b))) { + if (isinf(sexp_flonum_value(b)) || + sexp_flonum_value(b) != trunc(sexp_flonum_value(b))) { r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, b); } else { tmp = sexp_bignum_normalize(sexp_double_to_bignum(ctx, sexp_flonum_value(b))); From c5345a5b485c201c8a6ddc2c1319951a788d976d Mon Sep 17 00:00:00 2001 From: John Croisant Date: Thu, 15 Mar 2018 21:37:08 -0500 Subject: [PATCH 2/4] Fix errors in tests/division-tests.scm. Import (scheme base) to get the basic division procedures. The "centered" procedures were renamed to "balanced" in commit 975dc690a17bccfed157bde283056ab02f77e092. Also cleaned up some trailing whitespace. --- tests/division-tests.scm | 100 +++++++++++++++++++-------------------- 1 file changed, 50 insertions(+), 50 deletions(-) diff --git a/tests/division-tests.scm b/tests/division-tests.scm index 41cf6d43..ae231f66 100644 --- a/tests/division-tests.scm +++ b/tests/division-tests.scm @@ -1,5 +1,5 @@ -(import (chibi test) (scheme division)) +(import (chibi test) (scheme base) (scheme division)) (test-begin "division") @@ -16,13 +16,13 @@ (test -4.0 (ceiling -4.3)) (test -4.0 (truncate -4.3)) (test -4.0 (round -4.3)) -(test 3.0 (floor 3.5)) -(test 4.0 (ceiling 3.5)) -(test 3.0 (truncate 3.5)) +(test 3.0 (floor 3.5)) +(test 4.0 (ceiling 3.5)) +(test 3.0 (truncate 3.5)) (test 4.0 (round 3.5)) -(test -4.0 (floor -3.5)) -(test -3.0 (ceiling -3.5)) -(test -3.0 (truncate -3.5)) +(test -4.0 (floor -3.5)) +(test -3.0 (ceiling -3.5)) +(test -3.0 (truncate -3.5)) (test -4.0 (round -3.5)) (test 3 (floor (/ 1300000000000000000000 400000000000000000000))) (test 4 (ceiling (/ 1300000000000000000000 400000000000000000000))) @@ -87,11 +87,11 @@ (test 0 (euclidean-remainder 0 4)) (test 0 (euclidean-remainder 0 -4)) -(test 0 (centered-quotient 0 4)) -(test 0 (centered-quotient 0 -4)) +(test 0 (balanced-quotient 0 4)) +(test 0 (balanced-quotient 0 -4)) -(test 0 (centered-remainder 0 4)) -(test 0 (centered-remainder 0 -4)) +(test 0 (balanced-remainder 0 4)) +(test 0 (balanced-remainder 0 -4)) (test-end) @@ -129,11 +129,11 @@ (test 0 (euclidean-remainder 13 1)) (test 0 (euclidean-remainder -13 1)) -(test 13 (centered-quotient 13 1)) -(test -13 (centered-quotient -13 1)) +(test 13 (balanced-quotient 13 1)) +(test -13 (balanced-quotient -13 1)) -(test 0 (centered-remainder 13 1)) -(test 0 (centered-remainder -13 1)) +(test 0 (balanced-remainder 13 1)) +(test 0 (balanced-remainder -13 1)) (test-end) @@ -205,18 +205,18 @@ (test 1 (euclidean-remainder 13 -4)) (test 3 (euclidean-remainder -13 -4)) -;; Centered differs from truncate only in the 0.5 remainder border +;; Balanced differs from truncate only in the 0.5 remainder border ;; case in the next test group. -(test 3 (centered-quotient 13 4)) -(test -3 (centered-quotient -13 4)) -(test -3 (centered-quotient 13 -4)) -(test 3 (centered-quotient -13 -4)) +(test 3 (balanced-quotient 13 4)) +(test -3 (balanced-quotient -13 4)) +(test -3 (balanced-quotient 13 -4)) +(test 3 (balanced-quotient -13 -4)) -(test 1 (centered-remainder 13 4)) -(test -1 (centered-remainder -13 4)) -(test 1 (centered-remainder 13 -4)) -(test -1 (centered-remainder -13 -4)) +(test 1 (balanced-remainder 13 4)) +(test -1 (balanced-remainder -13 4)) +(test 1 (balanced-remainder 13 -4)) +(test -1 (balanced-remainder -13 -4)) (test-end) @@ -279,17 +279,17 @@ (test 1 (round-remainder 13 -2)) (test -1 (round-remainder -13 -2)) -;; Centered rounds up when exactly half-way between two integers. +;; Balanced rounds up when exactly half-way between two integers. -(test 7 (centered-quotient 13 2)) -(test -6 (centered-quotient -13 2)) -(test -7 (centered-quotient 13 -2)) -(test 6 (centered-quotient -13 -2)) +(test 7 (balanced-quotient 13 2)) +(test -6 (balanced-quotient -13 2)) +(test -7 (balanced-quotient 13 -2)) +(test 6 (balanced-quotient -13 -2)) -(test -1 (centered-remainder 13 2)) -(test -1 (centered-remainder -13 2)) -(test -1 (centered-remainder 13 -2)) -(test -1 (centered-remainder -13 -2)) +(test -1 (balanced-remainder 13 2)) +(test -1 (balanced-remainder -13 2)) +(test -1 (balanced-remainder 13 -2)) +(test -1 (balanced-remainder -13 -2)) (test-end) @@ -359,17 +359,17 @@ (test 1.0 (euclidean-remainder 13 4.0)) (test 1.0 (euclidean-remainder 13.0 4.0)) -(test '(3.0 1.0) (values->list (centered/ 13.0 4))) -(test '(3.0 1.0) (values->list (centered/ 13 4.0))) -(test '(3.0 1.0) (values->list (centered/ 13.0 4.0))) +(test '(3.0 1.0) (values->list (balanced/ 13.0 4))) +(test '(3.0 1.0) (values->list (balanced/ 13 4.0))) +(test '(3.0 1.0) (values->list (balanced/ 13.0 4.0))) -(test 3.0 (centered-quotient 13.0 4)) -(test 3.0 (centered-quotient 13 4.0)) -(test 3.0 (centered-quotient 13.0 4.0)) +(test 3.0 (balanced-quotient 13.0 4)) +(test 3.0 (balanced-quotient 13 4.0)) +(test 3.0 (balanced-quotient 13.0 4.0)) -(test 1.0 (centered-remainder 13.0 4)) -(test 1.0 (centered-remainder 13 4.0)) -(test 1.0 (centered-remainder 13.0 4.0)) +(test 1.0 (balanced-remainder 13.0 4)) +(test 1.0 (balanced-remainder 13 4.0)) +(test 1.0 (balanced-remainder 13.0 4.0)) (test-end) @@ -448,19 +448,19 @@ (test 300000000000000000000 (euclidean-remainder -1300000000000000000000 -400000000000000000000)) -(test 3 (centered-quotient 1300000000000000000000 400000000000000000000)) -(test -3 (centered-quotient -1300000000000000000000 400000000000000000000)) -(test -3 (centered-quotient 1300000000000000000000 -400000000000000000000)) -(test 3 (centered-quotient -1300000000000000000000 -400000000000000000000)) +(test 3 (balanced-quotient 1300000000000000000000 400000000000000000000)) +(test -3 (balanced-quotient -1300000000000000000000 400000000000000000000)) +(test -3 (balanced-quotient 1300000000000000000000 -400000000000000000000)) +(test 3 (balanced-quotient -1300000000000000000000 -400000000000000000000)) (test 100000000000000000000 - (centered-remainder 1300000000000000000000 400000000000000000000)) + (balanced-remainder 1300000000000000000000 400000000000000000000)) (test -100000000000000000000 - (centered-remainder -1300000000000000000000 400000000000000000000)) + (balanced-remainder -1300000000000000000000 400000000000000000000)) (test 100000000000000000000 - (centered-remainder 1300000000000000000000 -400000000000000000000)) + (balanced-remainder 1300000000000000000000 -400000000000000000000)) (test -100000000000000000000 - (centered-remainder -1300000000000000000000 -400000000000000000000)) + (balanced-remainder -1300000000000000000000 -400000000000000000000)) (test-end) From 3c41f9d3e28494fe8eb83a0b7fc738b6c3d4ec47 Mon Sep 17 00:00:00 2001 From: John Croisant Date: Thu, 15 Mar 2018 21:43:21 -0500 Subject: [PATCH 3/4] Add "test-division" Makefile target. Runs tests/division-tests.scm. The "test-all" target now also runs test-division. --- Makefile | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index f32a4022..cc935cae 100644 --- a/Makefile +++ b/Makefile @@ -270,6 +270,9 @@ test-snow: chibi-scheme$(EXE) $(IMAGE_FILES) test-unicode: chibi-scheme$(EXE) $(CHIBI) -xchibi tests/unicode-tests.scm +test-division: chibi-scheme$(EXE) + $(CHIBI) tests/division-tests.scm + test-libs: chibi-scheme$(EXE) $(CHIBI) tests/lib-tests.scm @@ -281,7 +284,7 @@ test-r7rs: chibi-scheme$(EXE) test: test-r7rs -test-all: test test-libs test-ffi +test-all: test test-libs test-ffi test-division test-dist: test-all test-memory test-build From fe85ccc94a57c761cafeb0b860b0f2860b63c906 Mon Sep 17 00:00:00 2001 From: John Croisant Date: Thu, 15 Mar 2018 21:48:19 -0500 Subject: [PATCH 4/4] Add regression tests for remainder with infinity. --- tests/division-tests.scm | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/tests/division-tests.scm b/tests/division-tests.scm index ae231f66..9399e61f 100644 --- a/tests/division-tests.scm +++ b/tests/division-tests.scm @@ -464,4 +464,26 @@ (test-end) +(test-begin "remainder infinity") + +(test-error (remainder +inf.0 +nan.0)) +(test-error (remainder -inf.0 +nan.0)) +(test-error (remainder +inf.0 2.0)) +(test-error (remainder -inf.0 2.0)) +(test-error (remainder +inf.0 2/1)) +(test-error (remainder -inf.0 2/1)) +(test-error (remainder +inf.0 2)) +(test-error (remainder -inf.0 2)) + +(test-error (remainder +nan.0 +inf.0)) +(test-error (remainder +nan.0 -inf.0)) +(test-error (remainder 2.0 +inf.0)) +(test-error (remainder 2.0 -inf.0)) +(test-error (remainder 2/1 +inf.0)) +(test-error (remainder 2/1 -inf.0)) +(test-error (remainder 2 +inf.0)) +(test-error (remainder 2 -inf.0)) + +(test-end "remainder infinity") + (test-end)