Fix bugs in expt and integer-expt

* 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.

diff --git a/libguile/numbers.c b/libguile/numbers.c
index d5ebf9c..21f2383 100644 (file)
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -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)));

diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test
index b365c64..b548ad8 100644 (file)
--- a/test-suite/tests/numbers.test
+++ b/test-suite/tests/numbers.test
@@ -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