diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclExecute.c | 61 | ||||
| -rw-r--r-- | tests/expr-old.test | 24 |
3 files changed, 84 insertions, 7 deletions
@@ -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." |