diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclExecute.c | 52 | ||||
| -rw-r--r-- | tests/expr.test | 8 |
3 files changed, 21 insertions, 47 deletions
@@ -1,3 +1,11 @@ +2006-09-19 Don Porter <dgp@users.sourceforge.net> + + * generic/tclExecute.c (INST_EXPON): Native type overflow detection + * tests/expr.test: was completely broken. Falling back on use of + bignums for all non-trivial ** calculations until + native-type-constrained special cases can be done carefully and + correctly. [Bug 1561260]. + 2006-09-15 Jeff Hobbs <jeffh@ActiveState.com> * library/http/http.tcl: Change " " -> "+" url encoding mapping diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d664134..7006d00 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.244 2006/09/11 04:54:11 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.245 2006/09/19 16:31:56 dgp Exp $ */ #include "tclInt.h" @@ -4694,7 +4694,7 @@ TclExecuteByteCode( /* TODO: Attempts to re-use unshared operands on stack */ if (*pc == INST_EXPON) { - long l2 = 0; + long l1, l2 = 0; int oddExponent = 0, negativeExponent = 0; if (type2 == TCL_NUMBER_LONG) { l2 = *((CONST long *)ptr2); @@ -4735,7 +4735,7 @@ TclExecuteByteCode( if (negativeExponent) { if (type1 == TCL_NUMBER_LONG) { - long l1 = *((CONST long *)ptr1); + l1 = *((CONST long *)ptr1); switch (l1) { case 0: /* zero to a negative power is div by zero error */ @@ -4762,7 +4762,7 @@ TclExecuteByteCode( } if (type1 == TCL_NUMBER_LONG) { - long l1 = *((CONST long *)ptr1); + l1 = *((CONST long *)ptr1); switch (l1) { case 0: /* zero to a positive power is zero */ @@ -4781,13 +4781,8 @@ TclExecuteByteCode( NEXT_INST_F(1, 2, 1); } } - - if (type2 != TCL_NUMBER_LONG) { - result = TCL_ERROR; - Tcl_SetObjResult(interp, - Tcl_NewStringObj("exponent too large", -1)); - goto checkForCatch; - } + /* TODO: Perform those computations that fit in native types */ + goto overflow; } if ((*pc != INST_MULT) @@ -4846,41 +4841,6 @@ TclExecuteByteCode( wResult -= 1; } break; - case INST_EXPON: { - /* TODO: smarter overflow detection ? */ - int wasNegative; - if (w2 & 1) { - wResult = w1; - } else { - wResult = Tcl_LongAsWide(1); - } - w1 *= w1; - w2 /= 2; - if (w2 == 0) { - break; - } - for (; w2>Tcl_LongAsWide(1) ; w1*=w1,w2/=2) { - wasNegative = (wResult < 0); - if (w1 <= 0) { - goto overflow; - } - if (w2 & 1) { - wResult *= w1; - if (wasNegative != (wResult < 0)) { - goto overflow; - } - } - } - wasNegative = (wResult < 0); - if (w1 <= 0) { - goto overflow; - } - wResult *= w1; - if (wasNegative != (wResult < 0)) { - goto overflow; - } - break; - } default: /* Unused, here to silence compiler warning. */ wResult = 0; diff --git a/tests/expr.test b/tests/expr.test index a26dc63..20ab38b 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr.test,v 1.60 2006/09/11 04:54:12 dgp Exp $ +# RCS: @(#) $Id: expr.test,v 1.61 2006/09/19 16:31:57 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -974,6 +974,12 @@ test expr-23.42 {INST_EXPON: overflow to big integer} {expr 4**32} [expr 1<<64] test expr-23.43 {INST_EXPON: overflow to big integer} {expr 16**16} [expr 1<<64] test expr-23.44 {INST_EXPON: overflow to big integer} {expr 256**8} [expr 1<<64] test expr-23.45 {INST_EXPON: Bug 1555371} {expr 2**1} 2 +test expr-23.46 {INST_EXPON: Bug 1561260} -body { + expr 5**28 +} -match glob -result *5 +test expr-23.47 {INST_EXPON: Bug 1561260} { + expr 2**32*5**32 +} 1[string repeat 0 32] # Some compilers get this wrong; ensure that we work around it correctly test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0 |