summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclExecute.c61
-rw-r--r--tests/expr-old.test24
3 files changed, 84 insertions, 7 deletions
diff --git a/ChangeLog b/ChangeLog
index ff56051..309fb4e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2002-07-24 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclExecute.c:
+ * tests/expr-old.test: fix for erroneous error messages in [expr],
+ [Bug 587140] reported by Martin Lemburg.
+
2002-07-25 Joe English <jenglish@users.sourceforge.net>
* generic/tclProc.c: fix for Tk Bug #219218 "error handling
with bgerror in Tk"
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 8ff5d23..a74a333 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,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.83 2002/07/24 23:20:50 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.84 2002/07/26 18:51:02 msofer Exp $
*/
#include "tclInt.h"
@@ -4337,10 +4337,12 @@ IllegalExprOperandType(interp, pc, opndPtr)
operatorStrings[opCode - INST_LOR], "\"", (char *) NULL);
} else {
char *msg = "non-numeric string";
- char *s;
+ char *s, *p;
int length;
+ int looksLikeInt = 0;
s = Tcl_GetStringFromObj(opndPtr, &length);
+ p = s;
/*
* strtod() isn't particularly consistent about detecting Inf
* and NaN between platforms.
@@ -4357,13 +4359,60 @@ IllegalExprOperandType(interp, pc, opndPtr)
goto makeErrorMessage;
}
}
- if (TclLooksLikeInt(s, length)) {
+
+ /*
+ * We cannot use TclLooksLikeInt here because it passes strings
+ * like "10;" [Bug 587140]. We'll accept as "looking like ints"
+ * for the present purposes any string that looks formally like
+ * a (decimal|octal|hex) integer.
+ */
+
+ while (length && isspace(UCHAR(*p))) {
+ length--;
+ p++;
+ }
+ if (length && ((*p == '+') || (*p == '-'))) {
+ length--;
+ p++;
+ }
+ if (length) {
+ if ((*p == '0') && ((*(p+1) == 'x') || (*(p+1) == 'X'))) {
+ p += 2;
+ length -= 2;
+ looksLikeInt = ((length > 0) && isxdigit(UCHAR(*p)));
+ if (looksLikeInt) {
+ length--;
+ p++;
+ while (length && isxdigit(UCHAR(*p))) {
+ length--;
+ p++;
+ }
+ }
+ } else {
+ looksLikeInt = (length && isdigit(UCHAR(*p)));
+ if (looksLikeInt) {
+ length--;
+ p++;
+ while (length && isdigit(UCHAR(*p))) {
+ length--;
+ p++;
+ }
+ }
+ }
+ while (length && isspace(UCHAR(*p))) {
+ length--;
+ p++;
+ }
+ looksLikeInt = !length;
+ }
+ if (looksLikeInt) {
/*
- * If something that looks like an integer appears here, then
- * it *must* be a bad octal or too large to represent [Bug 542588].
+ * If something that looks like an integer could not be converted,
+ * then it *must* be a bad octal or too large to represent
+ * [Bug 542588].
*/
- if (TclCheckBadOctal(NULL, Tcl_GetString(opndPtr))) {
+ if (TclCheckBadOctal(NULL, s)) {
msg = "invalid octal number";
} else {
msg = "integer value too large to represent";
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 3cf9959..a90366e 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -13,7 +13,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-old.test,v 1.14 2002/04/18 13:04:20 msofer Exp $
+# RCS: @(#) $Id: expr-old.test,v 1.15 2002/07/26 18:51:02 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -941,6 +941,28 @@ test expr-old-36.11 {ExprLooksLikeInt procedure} {
list [catch {expr {$x+1}} msg] $msg
} {1 {can't use integer value too large to represent as operand of "+"}}
+# tests for [Bug #587140]
+test expr-old-36.12 {ExprLooksLikeInt procedure} {
+ set x "10;"
+ list [catch {expr {$x+1}} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test expr-old-36.13 {ExprLooksLikeInt procedure} {
+ set x " +"
+ list [catch {expr {$x+1}} msg] $msg
+} {1 {can't use non-numeric string as operand of "+"}}
+test expr-old-36.14 {ExprLooksLikeInt procedure} {
+ set x "123456789012345678901234567890 "
+ list [catch {expr {$x+1}} msg] $msg
+} {1 {can't use integer value too large to represent as operand of "+"}}
+test expr-old-36.15 {ExprLooksLikeInt procedure} {
+ set x "099 "
+ list [catch {expr {$x+1}} msg] $msg
+} {1 {can't use invalid octal number as operand of "+"}}
+test expr-old-36.16 {ExprLooksLikeInt procedure} {
+ set x " 0xffffffffffffffffffffffffffffffffffffff "
+ list [catch {expr {$x+1}} msg] $msg
+} {1 {can't use integer value too large to represent as operand of "+"}}
+
if {[info commands testexprlong] == {}} {
puts "This application hasn't been compiled with the \"testexprlong\""
puts "command, so I can't test Tcl_ExprLong etc."