[gimp] R5RS compatability fix for expt (SourceForge bug #3399332)



commit a8966b8485a2ca6d2f9edea5824e649a5b73e39d
Author: Kevin Cozens <kcozens svn gnome org>
Date:   Tue Aug 30 12:00:00 2011 -0400

    R5RS compatability fix for expt (SourceForge bug #3399332)

 plug-ins/script-fu/tinyscheme/scheme.c |   18 +++++++++++++++---
 1 files changed, 15 insertions(+), 3 deletions(-)
---
diff --git a/plug-ins/script-fu/tinyscheme/scheme.c b/plug-ins/script-fu/tinyscheme/scheme.c
index 5633ec6..8f88647 100644
--- a/plug-ins/script-fu/tinyscheme/scheme.c
+++ b/plug-ins/script-fu/tinyscheme/scheme.c
@@ -3340,11 +3340,23 @@ static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
           if(cdr(sc->args)==sc->NIL) {
                Error_0(sc,"expt: needs two arguments");
           } 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. */
-               if (rvalue(x) == 0 && rvalue(y) < 0)
-                   s_return(sc, mk_real(sc, 0));
-               s_return(sc, mk_real(sc, pow(rvalue(x),rvalue(y))));
+               /* 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));
+               }
           }
 
      case OP_FLOOR:



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