diff options
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 41fe7d8..8c69ecc 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.150.2.4 2007/09/04 17:43:48 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.150.2.5 2007/10/15 18:38:06 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; |