summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdMZ.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-10-11 21:34:59 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-10-11 21:34:59 (GMT)
commita5410fb3a1a9a28c9d7261e9f2e96518f557de36 (patch)
tree9c7e9a92ddeeade771662fa39dbd533371b09288 /generic/tclCmdMZ.c
parent9db323e98ffbbcc1293e10187377516b6fea0b58 (diff)
downloadtcl-a5410fb3a1a9a28c9d7261e9f2e96518f557de36.zip
tcl-a5410fb3a1a9a28c9d7261e9f2e96518f557de36.tar.gz
tcl-a5410fb3a1a9a28c9d7261e9f2e96518f557de36.tar.bz2
* generic/tclCmdMZ.c: Correct [string is (wide)integer] failure
* tests/string.test: to report correct failindex values for non-decimal integer strings. [Bug 1805887]. * compat/strtoll.c (removed): The routines strtoll() and strtoull() * compat/strtoull.c (removed): are no longer called by the Tcl source * generic/tcl.h: code. (Their functionality has been replaced * unix/Makefile.in: by TclParseNumber().) Remove outdated comments * unix/configure.in: and mountains of configury autogoo that * unix/tclUnixPort.h: allegedly support the mythical systems where * win/Makefile.in: these routines might not have been available. * win/makefile.bc: * win/makefile.vc: * win/tclWinPort.h: * unix/configure: autoconf-2.59
Diffstat (limited to 'generic/tclCmdMZ.c')
-rw-r--r--generic/tclCmdMZ.c117
1 files changed, 39 insertions, 78 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 7da20c5..c241cf3 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.154 2007/08/12 21:58:11 msofer Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.155 2007/10/11 21:35:00 dgp Exp $
*/
#include "tclInt.h"
@@ -1401,7 +1401,7 @@ Tcl_StringObjCmd(
break;
}
case STR_IS: {
- char *end;
+ char *end, *stop;
Tcl_UniChar ch;
/*
@@ -1521,8 +1521,6 @@ Tcl_StringObjCmd(
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
- char *stop;
-
/* TODO */
if ((objPtr->typePtr == &tclDoubleType) ||
(objPtr->typePtr == &tclIntType) ||
@@ -1549,49 +1547,53 @@ Tcl_StringObjCmd(
case STR_IS_GRAPH:
chcomp = Tcl_UniCharIsGraph;
break;
- case STR_IS_INT: {
- char *stop;
- long int l = 0;
-
- if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &i)) {
+ case STR_IS_INT:
+ case STR_IS_WIDE:
+ if ((((enum isOptions) index) == STR_IS_INT)
+ && (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &i))) {
+ break;
+ }
+ if ((((enum isOptions) index) == STR_IS_WIDE)
+ && (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w))) {
break;
}
-
- /*
- * Like STR_IS_DOUBLE, but we use strtoul. Since Tcl_GetIntFromObj
- * already failed, we set result to 0.
- */
result = 0;
- errno = 0;
- l = strtol(string1, &stop, 0); /* INTL: Tcl source. */
- if ((errno == ERANGE) || (l > INT_MAX) || (l < INT_MIN)) {
- /*
- * if (errno == ERANGE) or the long value won't fit in an int,
- * then it was an over/underflow problem, but in this method,
- * we only want to know yes or no, so bad flow returns 0
- * (false) and sets the failVarObj to the string length.
- */
- failat = -1;
- } else if (stop == string1) {
+ if (failVarObj == NULL) {
/*
- * In this case, nothing like a number was found
+ * Don't bother computing the failure point if we're not
+ * going to return it.
*/
-
- failat = 0;
+ break;
+ }
+ if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
+ (const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
+ if (stop == end) {
+ /*
+ * Entire string parses as an integer, but rejected by
+ * Tcl_Get(Wide)IntFromObj() so we must have overflowed
+ * the target type, and our convention is to return
+ * failure at index -1 in that situation.
+ */
+ failat = -1;
+ } else {
+ /*
+ * Some prefix parsed as an integer, but not the whole
+ * string, so return failure index as the point where
+ * parsing stopped. Clear out the internal rep, since
+ * keeping it would leave *objPtr in an inconsistent
+ * state.
+ */
+ failat = stop - string1;
+ TclFreeIntRep(objPtr);
+ objPtr->typePtr = NULL;
+ }
} else {
- /*
- * Assume we sucked up one char per byte and then we go onto
- * SPACE, since we are allowed trailing whitespace.
- */
-
- failat = stop - string1;
- string1 = stop;
- chcomp = Tcl_UniCharIsSpace;
+ /* No prefix is a valid integer. Fail at beginning. */
+ failat = 0;
}
break;
- }
case STR_IS_LIST:
/*
* We ignore the strictness here, since empty strings are always
@@ -1661,47 +1663,6 @@ Tcl_StringObjCmd(
case STR_IS_UPPER:
chcomp = Tcl_UniCharIsUpper;
break;
- case STR_IS_WIDE: {
- char *stop;
-
- if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
- break;
- }
-
- /*
- * Like STR_IS_DOUBLE, but we use strtoll. Since
- * Tcl_GetWideIntFromObj already failed, we set result to 0.
- */
-
- result = 0;
- errno = 0;
- w = strtoll(string1, &stop, 0); /* INTL: Tcl source. */
- if (errno == ERANGE) {
- /*
- * If (errno == ERANGE), then it was an over/underflow
- * problem, but in this method, we only want to know yes or
- * no, so bad flow returns 0 (false) and sets the failVarObj
- * to the string length.
- */
-
- failat = -1;
- } else if (stop == string1) {
- /*
- * In this case, nothing like a number was found
- */
- failat = 0;
- } else {
- /*
- * Assume we sucked up one char per byte and then we go onto
- * SPACE, since we are allowed trailing whitespace.
- */
-
- failat = stop - string1;
- string1 = stop;
- chcomp = Tcl_UniCharIsSpace;
- }
- break;
- }
case STR_IS_WORD:
chcomp = Tcl_UniCharIsWordChar;
break;