summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclExecute.c52
-rw-r--r--tests/expr.test8
3 files changed, 21 insertions, 47 deletions
diff --git a/ChangeLog b/ChangeLog
index 28f2dc1..0f4c66d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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