[gimp] R5RS compatability fix for expt. (See SourceForge bug #3399332) Based on the patch from Doug Currie.



commit b61b8782d0f4a1d3ded17db5f9bc1e1bd8a032cf
Author: Kevin Cozens <kcozens svn gnome org>
Date:   Sun Sep 4 16:33:39 2011 -0400

    R5RS compatability fix for expt. (See SourceForge bug #3399332)
    Based on the patch from Doug Currie.

 plug-ins/script-fu/tinyscheme/scheme.c |   45 +++++++++++++++++--------------
 1 files changed, 25 insertions(+), 20 deletions(-)
---
diff --git a/plug-ins/script-fu/tinyscheme/scheme.c b/plug-ins/script-fu/tinyscheme/scheme.c
index b89b02b..830c9f7 100644
--- a/plug-ins/script-fu/tinyscheme/scheme.c
+++ b/plug-ins/script-fu/tinyscheme/scheme.c
@@ -3339,29 +3339,34 @@ static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
           x=car(sc->args);
           s_return(sc, mk_real(sc, sqrt(rvalue(x))));
 
-     case OP_EXPT:
+     case OP_EXPT: {
+          double result;
+          int real_result=1;
+          pointer y=cadr(sc->args);
           x=car(sc->args);
-          if(cdr(sc->args)==sc->NIL) {
-               Error_0(sc,"expt: needs two arguments");
+          if (num_is_integer(x) && num_is_integer(y))
+             real_result=0;
+          /* This 'if' is an R5RS compatability fix. */
+          /* NOTE: Remove this 'if' fix for R6RS.    */
+          if (rvalue(x) == 0 && rvalue(y) < 0) {
+             result = 0.0;
           } else {
-               double result;
-               int real_result=1;
-               pointer y=cadr(sc->args);
-               if (num_is_integer(x) && num_is_integer(y))
-                  real_result=0;
-               /* This 'if' is an R5RS compatability fix. */
-               /* NOTE: Remove this 'if' fix for R6RS.    */
-               if (rvalue(x) == 0 && rvalue(y) < 0) {
-                  result = 0.0;
-               } else {
-                  result = pow(rvalue(x),rvalue(y));
-               }
-               if (real_result) {
-                  s_return(sc, mk_real(sc, result));
-               } else {
-                  s_return(sc, mk_integer(sc, result));
-               }
+             result = pow(rvalue(x),rvalue(y));
           }
+          /* Before returning integer result make sure we can. */
+          /* If the test fails, result is too big for integer. */
+          if (!real_result)
+          {
+            long result_as_long = (long)result;
+            if (result != (double)result_as_long)
+              real_result = 1;
+          }
+          if (real_result) {
+             s_return(sc, mk_real(sc, result));
+          } else {
+             s_return(sc, mk_integer(sc, result));
+          }
+     }
 
      case OP_FLOOR:
           x=car(sc->args);



[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]