From 3191ee86de3330b4bdbd39041743df0dcbdec924 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 26 Jan 2011 16:47:13 -0500 Subject: [PATCH] `even?' and `odd?' now throw exceptions only for non-numbers * libguile/numbers.c (scm_even_p, scm_odd_p): Throw exceptions only when applied to non-number objects, per R5RS. Previously threw exceptions for non-integers. (Note that NaNs _are_ considered numbers by scheme, despite their name). * test-suite/tests/numbers.test: Add more test cases for `even?' and `odd?'. * NEWS: Add NEWS entry. --- NEWS | 7 +++++++ libguile/numbers.c | 30 ++++++++++++++++++------------ test-suite/tests/numbers.test | 28 ++++++++++++++++++++++++++++ 3 files changed, 53 insertions(+), 12 deletions(-) diff --git a/NEWS b/NEWS index f2178f6..194ff7a 100644 --- a/NEWS +++ b/NEWS @@ -53,6 +53,13 @@ non-real complex numbers may contain NaNs in their real or complex parts. Such numbers are not real. In fact it is possible for a non-real complex number to be both a NaN and infinite. +*** `even?' and `odd?' now throw exceptions for non-numbers only + +scm_even_p `even?' and scm_odd_p `odd?' now throw exceptions only if +passed non-number objects, per R5RS. Previously, they threw +exceptions for non-integers. (Note that NaNs _are_ considered numbers +by scheme, despite their name). + *** `inf?' and `nan?' now throw exceptions for non-numbers scm_inf_p `inf?' and scm_nan_p `nan?' now throw exceptions if passed diff --git a/libguile/numbers.c b/libguile/numbers.c index bfe3699..32e50c7 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -546,18 +546,21 @@ SCM_DEFINE (scm_odd_p, "odd?", 1, 0, 0, scm_remember_upto_here_1 (n); return scm_from_bool (odd_p); } - else if (scm_is_true (scm_inf_p (n))) - SCM_WRONG_TYPE_ARG (1, n); else if (SCM_REALP (n)) { - double rem = fabs (fmod (SCM_REAL_VALUE(n), 2.0)); + double val = SCM_REAL_VALUE (n); + double rem; + + if (!SCM_I_CDBL_IS_FINITE (val)) + return SCM_BOOL_F; + rem = fabs (fmod (val, 2.0)); if (rem == 1.0) return SCM_BOOL_T; - else if (rem == 0.0) - return SCM_BOOL_F; else - SCM_WRONG_TYPE_ARG (1, n); + return SCM_BOOL_F; } + else if (SCM_NUMBERP (n)) + return SCM_BOOL_F; else SCM_WRONG_TYPE_ARG (1, n); } @@ -581,18 +584,21 @@ SCM_DEFINE (scm_even_p, "even?", 1, 0, 0, scm_remember_upto_here_1 (n); return scm_from_bool (even_p); } - else if (scm_is_true (scm_inf_p (n))) - SCM_WRONG_TYPE_ARG (1, n); else if (SCM_REALP (n)) { - double rem = fabs (fmod (SCM_REAL_VALUE(n), 2.0)); - if (rem == 1.0) + double val = SCM_REAL_VALUE (n); + double rem; + + if (!SCM_I_CDBL_IS_FINITE (val)) return SCM_BOOL_F; - else if (rem == 0.0) + rem = fabs (fmod (val, 2.0)); + if (rem == 0.0) return SCM_BOOL_T; else - SCM_WRONG_TYPE_ARG (1, n); + return SCM_BOOL_F; } + else if (SCM_NUMBERP (n)) + return SCM_BOOL_F; else SCM_WRONG_TYPE_ARG (1, n); } diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index 8851068..7a0510e 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -287,6 +287,20 @@ (pass-if (not (odd? 0))) (pass-if (not (odd? 2))) (pass-if (not (odd? -2))) + (pass-if (odd? 43)) + (pass-if (odd? 43.0)) + (pass-if (odd? -43)) + (pass-if (odd? -43.0)) + (pass-if (not (odd? 1/2))) + (pass-if (not (odd? -42))) + (pass-if (not (odd? -42.0))) + (pass-if (not (odd? 42))) + (pass-if (not (odd? 42.0))) + (pass-if (not (odd? 43.1))) + (pass-if (not (odd? 43.0+1.0i))) + (pass-if (not (odd? +inf.0))) + (pass-if (not (odd? -inf.0))) + (pass-if (not (odd? +nan.0))) (pass-if (odd? (+ (* 2 fixnum-max) 1))) (pass-if (not (odd? (* 2 fixnum-max)))) (pass-if (odd? (- (* 2 fixnum-min) 1))) @@ -301,6 +315,20 @@ (pass-if (even? 2)) (pass-if (even? -2)) (pass-if (even? 0)) + (pass-if (even? 42)) + (pass-if (even? 42.0)) + (pass-if (even? -42)) + (pass-if (even? -42.0)) + (pass-if (not (even? 1/2))) + (pass-if (not (even? -43))) + (pass-if (not (even? -43.0))) + (pass-if (not (even? 43))) + (pass-if (not (even? 43.0))) + (pass-if (not (even? 42.1))) + (pass-if (not (even? 42.0+1.0i))) + (pass-if (not (even? +inf.0))) + (pass-if (not (even? -inf.0))) + (pass-if (not (even? +nan.0))) (pass-if (not (even? 1))) (pass-if (not (even? -1))) (pass-if (not (even? (+ (* 2 fixnum-max) 1)))) -- 1.5.6.5