diff options
author | dgp <dgp@users.sourceforge.net> | 2007-10-11 21:34:59 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2007-10-11 21:34:59 (GMT) |
commit | a5410fb3a1a9a28c9d7261e9f2e96518f557de36 (patch) | |
tree | 9c7e9a92ddeeade771662fa39dbd533371b09288 /generic/tclCmdMZ.c | |
parent | 9db323e98ffbbcc1293e10187377516b6fea0b58 (diff) | |
download | tcl-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.c | 117 |
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; |