From b61b8782d0f4a1d3ded17db5f9bc1e1bd8a032cf Mon Sep 17 00:00:00 2001 From: Kevin Cozens Date: Sun, 4 Sep 2011 16:33:39 -0400 Subject: [PATCH] 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 file changed, 25 insertions(+), 20 deletions(-) diff --git a/plug-ins/script-fu/tinyscheme/scheme.c b/plug-ins/script-fu/tinyscheme/scheme.c index b89b02bba5..830c9f717f 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);