From fa102e73c3d14f52d089ec2faa55c9a7e87f4a23 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 9 Aug 2013 05:32:23 -0400 Subject: Fix numerator and denominator handling of signed zeroes and infinities. * libguile/numbers.c (scm_numerator, scm_denominator): Handle signed zeroes and infinities in accordance with the corresponding R6RS flonum procedures. * module/rnrs/arithmetic/flonums.scm (flnumerator, fldenominator): Remove special handling of infinities. * test-suite/tests/numbers.test (numerator, denominator): Add tests. Convert existing tests to use 'pass-if-equal'. * test-suite/tests/r6rs-arithmetic-flonums.test (flnumerator): Fix broken test of (flnumerator -0.0). --- libguile/numbers.c | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) (limited to 'libguile/numbers.c') diff --git a/libguile/numbers.c b/libguile/numbers.c index 5d64b4ab2..b9e453a63 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -9183,7 +9183,15 @@ SCM_PRIMITIVE_GENERIC (scm_numerator, "numerator", 1, 0, 0, else if (SCM_FRACTIONP (z)) return SCM_FRACTION_NUMERATOR (z); else if (SCM_REALP (z)) - return scm_exact_to_inexact (scm_numerator (scm_inexact_to_exact (z))); + { + double zz = SCM_REAL_VALUE (z); + if (zz == floor (zz)) + /* Handle -0.0 and infinities in accordance with R6RS + flnumerator, and optimize handling of integers. */ + return z; + else + return scm_exact_to_inexact (scm_numerator (scm_inexact_to_exact (z))); + } else SCM_WTA_DISPATCH_1 (g_scm_numerator, z, SCM_ARG1, s_scm_numerator); } @@ -9200,7 +9208,15 @@ SCM_PRIMITIVE_GENERIC (scm_denominator, "denominator", 1, 0, 0, else if (SCM_FRACTIONP (z)) return SCM_FRACTION_DENOMINATOR (z); else if (SCM_REALP (z)) - return scm_exact_to_inexact (scm_denominator (scm_inexact_to_exact (z))); + { + double zz = SCM_REAL_VALUE (z); + if (zz == floor (zz)) + /* Handle infinities in accordance with R6RS fldenominator, and + optimize handling of integers. */ + return scm_i_from_double (1.0); + else + return scm_exact_to_inexact (scm_denominator (scm_inexact_to_exact (z))); + } else SCM_WTA_DISPATCH_1 (g_scm_denominator, z, SCM_ARG1, s_scm_denominator); } -- cgit v1.2.3