~ chicken-core (chicken-5) ae91f816d0a3911d71a37e22435f83ade9c77d69

commit ae91f816d0a3911d71a37e22435f83ade9c77d69
Author:     Christian Kellermann <address@hidden>
AuthorDate: Sun Mar 4 11:42:58 2012 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Mar 16 08:29:19 2012 +0100

    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.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/chicken.h b/chicken.h
index 66e83cce..9237e14a 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 49b91ca5..79a73699 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -20,7 +20,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 ()