>From 755d57fd1d3505154f4609b2bfbc0eeab371ccd0 Mon Sep 17 00:00:00 2001 From: Christian Kellermann
Date: Sun, 4 Mar 2012 11:42:58 +0100 Subject: [PATCH] Fix bug #791 and unpack flonums correctly for integer? The patch originally comes from Peter, I have added the tests for it. Maybe there should be more. --- chicken.h | 14 +++++++++----- tests/library-tests.scm | 12 ++++++++++++ 2 files changed, 21 insertions(+), 5 deletions(-) diff --git a/chicken.h b/chicken.h index b304d22..b5d83b1 100644 --- a/chicken.h +++ b/chicken.h @@ -2198,13 +2198,17 @@ C_inline int C_ub_i_fpintegerp(double x) C_inline C_word C_i_integerp(C_word x) { - double dummy; + double dummy, val; + + if (x & C_FIXNUM_BIT) + return C_SCHEME_TRUE; + if (C_immediatep(x) || C_block_header(x) != C_FLONUM_TAG) + return C_SCHEME_FALSE; - if(C_isnan(x) || C_isinf(x)) return C_SCHEME_FALSE; + val = C_flonum_magnitude(x); + if(C_isnan(val) || C_isinf(val)) return C_SCHEME_FALSE; - return C_mk_bool((x & C_FIXNUM_BIT) || - ((!C_immediatep(x) && C_block_header(x) == C_FLONUM_TAG) && - C_modf(C_flonum_magnitude(x), &dummy) == 0.0 ) ); + return C_mk_bool(C_modf(val, &dummy) == 0.0); } diff --git a/tests/library-tests.scm b/tests/library-tests.scm index 573348d..c8d5304 100644 --- a/tests/library-tests.scm +++ b/tests/library-tests.scm @@ -18,7 +18,19 @@ (assert (rational? 1)) (assert (rational? 1.0)) (assert (not (rational? +inf.))) +(assert (not (rational? -inf.))) +(assert (not (rational? +nan))) (assert (not (rational? 'foo))) +(assert (not (rational? "foo"))) +(assert (integer? 2)) +(assert (integer? 2.0)) +(assert (not (integer? 1.1))) +(assert (not (integer? +inf.))) +(assert (not (integer? -inf.))) +(assert (not (integer? +nan))) +(assert (not (integer? 'foo))) +(assert (not (integer? "foo"))) +; XXX number missing (define-syntax assert-fail (syntax-rules () -- 1.7.6