diff options
| author | Mark H Weaver <mhw@netris.org> | 2013-08-09 05:32:23 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2013-08-09 06:09:56 -0400 |
| commit | fa102e73c3d14f52d089ec2faa55c9a7e87f4a23 (patch) | |
| tree | 43f2e629012b84f843cc7e6edf404f4f2198f88d /libguile | |
| parent | d9b312af56666efa72cf15e87091b707ac600f13 (diff) | |
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).
Diffstat (limited to 'libguile')
| -rw-r--r-- | libguile/numbers.c | 20 |
1 files changed, 18 insertions, 2 deletions
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); } |