mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Fix bugs in expt and integer-expt

Browse source 
* libguile/numbers.c (scm_expt): Fix bug that caused expt to throw an
  exception whenever the base was exact and the exponent was an
  inexact integer, e.g. (expt 5 6.0).

  (scm_expt): Fix bug that caused expt to introduce spurious imaginary
  parts in the result when the base was an inexact negative real and
  the exponent was an integer, e.g. (expt -1.0 2)

  (scm_integer_expt, scm_expt): Change behavior of (integer-expt 0 -1),
  and therefore also (expt 0 -1), to return NaN, per R6RS (actually,
  R6RS says we should throw an exception or return an "unspecified
  number object", but for now we use NaN).  Formerly we returned 0, per
  R5RS. R5RS claims that 0^x=0 for all non-zero x, but that's
  mathematically incorrect, and probably an oversight.

  (scm_integer_expt): Consistently throw a wrong-argument-type exception
  when the exponent is inexact.  Formerly, it didn't always check this
  if the base was 0, 1, or -1.

* test-suite/tests/numbers.test ("integer-expt", "expt"): Add tests.
This commit is contained in:
Mark H Weaver 2010-11-04 22:10:02 -04:00 • committed by Andy Wingo
parent b1846b7fb3
commit 01c7284ae5
2 changed files with 79 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

41
libguile/numbers.c
View file

@ -1798,10 +1798,20 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0,
SCM acc = SCM_I_MAKINUM (1L);
SCM_VALIDATE_NUMBER (SCM_ARG1, n);
if (!SCM_I_INUMP (k) && !SCM_BIGP (k))
SCM_WRONG_TYPE_ARG (2, k);
/* 0^0 == 1 according to R5RS */
if (scm_is_eq (n, SCM_INUM0) || scm_is_eq (n, acc))
return scm_is_false (scm_zero_p(k)) ? n : acc;
if (scm_is_true (scm_zero_p (n)))
{
if (scm_is_true (scm_zero_p (k))) /* 0^0 == 1 per R5RS */
return acc; /* return exact 1, regardless of n */
else if (scm_is_true (scm_positive_p (k)))
return n;
else /* return NaN for (0 ^ k) for negative k per R6RS */
return scm_nan ();
}
else if (scm_is_eq (n, acc))
return acc;
else if (scm_is_eq (n, SCM_I_MAKINUM (-1L)))
return scm_is_false (scm_even_p (k)) ? n : acc;
@ -5479,8 +5489,29 @@ SCM_DEFINE (scm_expt, "expt", 2, 0, 0,
"Return @var{x} raised to the power of @var{y}.")
#define FUNC_NAME s_scm_expt
{
if (scm_is_true (scm_exact_p (x)) && scm_is_integer (y))
return scm_integer_expt (x, y);
if (scm_is_integer (y))
{
if (scm_is_true (scm_exact_p (y)))
return scm_integer_expt (x, y);
else
{
/* Here we handle the case where the exponent is an inexact
integer. We make the exponent exact in order to use
scm_integer_expt, and thus avoid the spurious imaginary
parts that may result from round-off errors in the general
e^(y log x) method below (for example when squaring a large
negative number). In this case, we must return an inexact
result for correctness. We also make the base inexact so
that scm_integer_expt will use fast inexact arithmetic
internally. Note that making the base inexact is not
sufficient to guarantee an inexact result, because
scm_integer_expt will return an exact 1 when the exponent
is 0, even if the base is inexact. */
return scm_exact_to_inexact
(scm_integer_expt (scm_exact_to_inexact (x),
scm_inexact_to_exact (y)));
}
}
else if (scm_is_real (x) && scm_is_real (y) && scm_to_double (x) >= 0.0)
{
return scm_from_double (pow (scm_to_double (x), scm_to_double (y)));

48
test-suite/tests/numbers.test
View file

@ -2925,10 +2925,32 @@
(with-test-prefix "expt"
(pass-if-exception "non-numeric base" exception:wrong-type-arg
(expt #t 0))
(pass-if "(= 1 (expt 0 0))" (= 1 (expt 0 0)))
(pass-if "(= 1 (expt 0 0.0))" (= 1 (expt 0 0.0)))
(pass-if "(= 1 (expt 0.0 0))" (= 1 (expt 0.0 0)))
(pass-if "(= 1 (expt 0.0 0.0))" (= 1 (expt 0.0 0.0))))
(pass-if (eqv? 1 (expt 0 0)))
(pass-if (eqv? 1 (expt 0.0 0)))
(pass-if (eqv? 1.0 (expt 0 0.0)))
(pass-if (eqv? 1.0 (expt 0.0 0.0)))
(pass-if (nan? (expt 0 -1)))
(pass-if (nan? (expt 0 -1.0)))
(pass-if (nan? (expt 0.0 -1)))
(pass-if (nan? (expt 0.0 -1.0)))
(pass-if (eqv? 0 (expt 0 3)))
(pass-if (= 0 (expt 0 4.0)))
(pass-if (eqv? 0.0 (expt 0.0 5)))
(pass-if (eqv? 0.0 (expt 0.0 6.0)))
(pass-if (eqv? -2742638075.5 (expt -2742638075.5 1)))
(pass-if (eqv? (* -2742638075.5 -2742638075.5)
(expt -2742638075.5 2)))
(pass-if (eqv? 4.0 (expt -2.0 2.0)))
(pass-if (eqv? -1/8 (expt -2 -3)))
(pass-if (eqv? -0.125 (expt -2.0 -3)))
(pass-if (eqv? -0.125 (expt -2 -3.0)))
(pass-if (eqv? -0.125 (expt -2.0 -3.0)))
(pass-if (eqv? 0.25 (expt 2.0 -2.0)))
(pass-if (eqv? (* -1.0 12398 12398) (expt +12398i 2.0)))
(pass-if (eqv-loosely? +i (expt -1 0.5)))
(pass-if (eqv-loosely? +i (expt -1 1/2)))
(pass-if (eqv-loosely? 1.0+1.7320508075688i (expt -8 1/3))))
;;;
;;; asinh
@ -3050,7 +3072,23 @@
(pass-if-exception "2^-inf" exception:wrong-type-arg
(integer-expt 2 -inf.0))
(pass-if-exception "2^nan" exception:wrong-type-arg
(integer-expt 2 +nan.0)))
(integer-expt 2 +nan.0))
(pass-if (eqv? 1 (integer-expt 0 0)))
(pass-if (eqv? 1 (integer-expt 0.0 0)))
(pass-if (nan? (integer-expt 0 -1)))
(pass-if (nan? (integer-expt 0.0 -1)))
(pass-if (eqv? 0 (integer-expt 0 3)))
(pass-if (eqv? 0.0 (integer-expt 0.0 5)))
(pass-if (eqv? -2742638075.5 (integer-expt -2742638075.5 1)))
(pass-if (eqv? (* -2742638075.5 -2742638075.5)
(integer-expt -2742638075.5 2)))
(pass-if (eqv? 4.0 (integer-expt -2.0 2)))
(pass-if (eqv? -1/8 (integer-expt -2 -3)))
(pass-if (eqv? -0.125 (integer-expt -2.0 -3)))
(pass-if (eqv? 0.25 (integer-expt 2.0 -2)))
(pass-if (eqv? (* -1.0 12398 12398) (integer-expt +12398.0i 2))))
;;;
;;; integer-length