diff options
Diffstat (limited to 'generic/tclScan.c')
| -rw-r--r-- | generic/tclScan.c | 591 |
1 files changed, 220 insertions, 371 deletions
diff --git a/generic/tclScan.c b/generic/tclScan.c index 54f9b78..4dfc2d6 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -7,8 +7,6 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclScan.c,v 1.18 2005/07/21 14:38:51 dkf Exp $ */ #include "tclInt.h" @@ -22,14 +20,8 @@ #define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */ #define SCAN_WIDTH 0x8 /* A width value was supplied. */ -#define SCAN_SIGNOK 0x10 /* A +/- character is allowed. */ -#define SCAN_NODIGITS 0x20 /* No digits have been scanned. */ -#define SCAN_NOZERO 0x40 /* No zero digits have been scanned. */ -#define SCAN_XOK 0x80 /* An 'x' is allowed. */ -#define SCAN_PTOK 0x100 /* Decimal point is allowed. */ -#define SCAN_EXPOK 0x200 /* An exponent is allowed. */ - #define SCAN_LONGER 0x400 /* Asked for a wide value. */ +#define SCAN_BIG 0x800 /* Asked for a bignum value. */ /* * The following structure contains the information associated with a @@ -51,11 +43,11 @@ typedef struct CharSet { * Declarations for functions used only in this file. */ -static char * BuildCharSet _ANSI_ARGS_((CharSet *cset, char *format)); -static int CharInSet _ANSI_ARGS_((CharSet *cset, int ch)); -static void ReleaseCharSet _ANSI_ARGS_((CharSet *cset)); -static int ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format, - int numVars, int *totalVars)); +static const char * BuildCharSet(CharSet *cset, const char *format); +static int CharInSet(CharSet *cset, int ch); +static void ReleaseCharSet(CharSet *cset); +static int ValidateFormat(Tcl_Interp *interp, const char *format, + int numVars, int *totalVars); /* *---------------------------------------------------------------------- @@ -75,14 +67,14 @@ static int ValidateFormat _ANSI_ARGS_((Tcl_Interp *interp, char *format, *---------------------------------------------------------------------- */ -static char * -BuildCharSet(cset, format) - CharSet *cset; - char *format; /* Points to first char of set. */ +static const char * +BuildCharSet( + CharSet *cset, + const char *format) /* Points to first char of set. */ { Tcl_UniChar ch, start; int offset, nranges; - char *end; + const char *end; memset(cset, 0, sizeof(CharSet)); @@ -109,10 +101,9 @@ BuildCharSet(cset, format) end += Tcl_UtfToUniChar(end, &ch); } - cset->chars = (Tcl_UniChar *) ckalloc(sizeof(Tcl_UniChar) - * (end - format - 1)); + cset->chars = ckalloc(sizeof(Tcl_UniChar) * (end - format - 1)); if (nranges > 0) { - cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges); + cset->ranges = ckalloc(sizeof(struct Range) * nranges); } else { cset->ranges = NULL; } @@ -187,13 +178,14 @@ BuildCharSet(cset, format) */ static int -CharInSet(cset, c) - CharSet *cset; - int c; /* Character to test, passed as int because of +CharInSet( + CharSet *cset, + int c) /* Character to test, passed as int because of * non-ANSI prototypes. */ { Tcl_UniChar ch = (Tcl_UniChar) c; int i, match = 0; + for (i = 0; i < cset->nchars; i++) { if (cset->chars[i] == ch) { match = 1; @@ -202,8 +194,7 @@ CharInSet(cset, c) } if (!match) { for (i = 0; i < cset->nranges; i++) { - if ((cset->ranges[i].start <= ch) - && (ch <= cset->ranges[i].end)) { + if ((cset->ranges[i].start <= ch) && (ch <= cset->ranges[i].end)) { match = 1; break; } @@ -229,12 +220,12 @@ CharInSet(cset, c) */ static void -ReleaseCharSet(cset) - CharSet *cset; +ReleaseCharSet( + CharSet *cset) { - ckfree((char *)cset->chars); + ckfree(cset->chars); if (cset->ranges) { - ckfree((char *)cset->ranges); + ckfree(cset->ranges); } } @@ -256,22 +247,24 @@ ReleaseCharSet(cset) */ static int -ValidateFormat(interp, format, numVars, totalSubs) - Tcl_Interp *interp; /* Current interpreter. */ - char *format; /* The format string. */ - int numVars; /* The number of variables passed to the scan +ValidateFormat( + Tcl_Interp *interp, /* Current interpreter. */ + const char *format, /* The format string. */ + int numVars, /* The number of variables passed to the scan * command. */ - int *totalSubs; /* The number of variables that will be + int *totalSubs) /* The number of variables that will be * required. */ { -#define STATIC_LIST_SIZE 16 int gotXpg, gotSequential, value, i, flags; char *end; Tcl_UniChar ch; - int staticAssign[STATIC_LIST_SIZE]; - int *nassign = staticAssign; - int objIndex, xpgSize, nspace = STATIC_LIST_SIZE; + int objIndex, xpgSize, nspace = numVars; + int *nassign = TclStackAlloc(interp, nspace * sizeof(int)); char buf[TCL_UTF_MAX+1]; + Tcl_Obj *errorMsg; /* Place to build an error messages. Note that + * these are messy operations because we do + * not want to use the formatting engine; + * we're inside there! */ /* * Initialize an array that records the number of times a variable is @@ -279,10 +272,6 @@ ValidateFormat(interp, format, numVars, totalSubs) * is multiply assigned or left unassigned. */ - if (numVars > nspace) { - nassign = (int*)ckalloc(sizeof(int) * numVars); - nspace = numVars; - } for (i = 0; i < nspace; i++) { nassign[i] = 0; } @@ -307,14 +296,14 @@ ValidateFormat(interp, format, numVars, totalSubs) goto xpgCheckDone; } - if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ + if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ /* * Check for an XPG3-style %n$ specification. Note: there must * not be a mixture of XPG3 specs and non-XPG3 specs in the same * format string. */ - value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ + value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ if (*end != '$') { goto notXpg; } @@ -343,9 +332,10 @@ ValidateFormat(interp, format, numVars, totalSubs) gotSequential = 1; if (gotXpg) { mixedXPG: - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot mix \"%\" and \"%n$\" conversion specifiers", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL); goto error; } @@ -354,8 +344,8 @@ ValidateFormat(interp, format, numVars, totalSubs) * Parse any width specifier. */ - if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ - value = strtoul(format-1, &format, 10); /* INTL: "C" locale. */ + if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ + value = strtoul(format-1, (char **) &format, 10); /* INTL: "C" locale. */ flags |= SCAN_WIDTH; format += Tcl_UtfToUniChar(format, &ch); } @@ -366,6 +356,12 @@ ValidateFormat(interp, format, numVars, totalSubs) switch (ch) { case 'l': + if (*format == 'l') { + flags |= SCAN_BIG; + format += 1; + format += Tcl_UtfToUniChar(format, &ch); + break; + } case 'L': flags |= SCAN_LONGER; case 'h': @@ -383,9 +379,10 @@ ValidateFormat(interp, format, numVars, totalSubs) switch (ch) { case 'c': if (flags & SCAN_WIDTH) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "field width may not be specified in %c conversion", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL); goto error; } /* @@ -393,12 +390,15 @@ ValidateFormat(interp, format, numVars, totalSubs) */ case 'n': case 's': - if (flags & SCAN_LONGER) { - invalidLonger: + if (flags & (SCAN_LONGER|SCAN_BIG)) { + invalidFieldSize: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; - Tcl_AppendResult(interp, - "'l' modifier may not be specified in %", buf, - " conversion", NULL); + errorMsg = Tcl_NewStringObj( + "field size modifier may not be specified in %", -1); + Tcl_AppendToObj(errorMsg, buf, -1); + Tcl_AppendToObj(errorMsg, " conversion", -1); + Tcl_SetObjResult(interp, errorMsg); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL); goto error; } /* @@ -406,19 +406,30 @@ ValidateFormat(interp, format, numVars, totalSubs) */ case 'd': case 'e': + case 'E': case 'f': case 'g': + case 'G': case 'i': case 'o': - case 'u': case 'x': + case 'X': + case 'b': + break; + case 'u': + if (flags & SCAN_BIG) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unsigned bignum scans are invalid", -1)); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL); + goto error; + } break; /* * Bracket terms need special checking */ case '[': - if (flags & SCAN_LONGER) { - goto invalidLonger; + if (flags & (SCAN_LONGER|SCAN_BIG)) { + goto invalidFieldSize; } if (*format == '\0') { goto badSet; @@ -444,18 +455,19 @@ ValidateFormat(interp, format, numVars, totalSubs) } break; badSet: - Tcl_SetResult(interp, "unmatched [ in format string", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unmatched [ in format string", -1)); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL); goto error; default: - { - char buf[TCL_UTF_MAX+1]; - - buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; - Tcl_AppendResult(interp, "bad scan conversion character \"", - buf, "\"", NULL); - goto error; - } + buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; + errorMsg = Tcl_NewStringObj( + "bad scan conversion character \"", -1); + Tcl_AppendToObj(errorMsg, buf, -1); + Tcl_AppendToObj(errorMsg, "\"", -1); + Tcl_SetObjResult(interp, errorMsg); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL); + goto error; } if (!(flags & SCAN_SUPPRESS)) { if (objIndex >= nspace) { @@ -469,17 +481,10 @@ ValidateFormat(interp, format, numVars, totalSubs) if (xpgSize) { nspace = xpgSize; } else { - nspace += STATIC_LIST_SIZE; - } - if (nassign == staticAssign) { - nassign = (void *)ckalloc(nspace * sizeof(int)); - for (i = 0; i < STATIC_LIST_SIZE; ++i) { - nassign[i] = staticAssign[i]; - } - } else { - nassign = (void *)ckrealloc((void *)nassign, - nspace * sizeof(int)); + nspace += 16; /* formerly STATIC_LIST_SIZE */ } + nassign = TclStackRealloc(interp, nassign, + nspace * sizeof(int)); for (i = value; i < nspace; i++) { nassign[i] = 0; } @@ -505,9 +510,10 @@ ValidateFormat(interp, format, numVars, totalSubs) } for (i = 0; i < numVars; i++) { if (nassign[i] > 1) { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "variable is assigned by multiple \"%n$\" conversion specifiers", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL); goto error; } else if (!xpgSize && (nassign[i] == 0)) { /* @@ -515,34 +521,32 @@ ValidateFormat(interp, format, numVars, totalSubs) * and/or numVars != 0), then too many vars were given */ - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "variable is not assigned by any conversion specifiers", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL); goto error; } } - if (nassign != staticAssign) { - ckfree((char *)nassign); - } + TclStackFree(interp, nassign); return TCL_OK; badIndex: if (gotXpg) { - Tcl_SetResult(interp, "\"%n$\" argument index out of range", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "\"%n$\" argument index out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL); } else { - Tcl_SetResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "different numbers of variable names and field specifiers", - TCL_STATIC); + -1)); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL); } error: - if (nassign != staticAssign) { - ckfree((char *)nassign); - } + TclStackFree(interp, nassign); return TCL_ERROR; -#undef STATIC_LIST_SIZE } /* @@ -564,26 +568,20 @@ ValidateFormat(interp, format, numVars, totalSubs) /* ARGSUSED */ int -Tcl_ScanObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_ScanObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - char *format; + const char *format; int numVars, nconversions, totalVars = -1; int objIndex, offset, i, result, code; long value; - char *string, *end, *baseString; + const char *string, *end, *baseString; char op = 0; - int base = 0; - int underflow = 0; - size_t width; - long (*fn) _ANSI_ARGS_((char*,void*,int)) = NULL; -#ifndef TCL_WIDE_INT_IS_LONG - Tcl_WideInt (*lfn) _ANSI_ARGS_((char*,void*,int)) = NULL; + int width, underflow = 0; Tcl_WideInt wideValue; -#endif Tcl_UniChar ch, sch; Tcl_Obj **objs = NULL, *objPtr = NULL; int flags; @@ -593,7 +591,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, - "string format ?varName varName ...?"); + "string format ?varName ...?"); return TCL_ERROR; } @@ -613,7 +611,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) */ if (totalVars > 0) { - objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * totalVars); + objs = ckalloc(sizeof(Tcl_Obj *) * totalVars); for (i = 0; i < totalVars; i++) { objs[i] = NULL; } @@ -631,6 +629,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) objIndex = 0; nconversions = 0; while (*format != '\0') { + int parseFlag = TCL_PARSE_NO_WHITESPACE; format += Tcl_UtfToUniChar(format, &ch); flags = 0; @@ -678,9 +677,10 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) flags |= SCAN_SUPPRESS; format += Tcl_UtfToUniChar(format, &ch); } else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ - value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ - if (*end == '$') { - format = end+1; + char *formatEnd; + value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */ + if (*formatEnd == '$') { + format = formatEnd+1; format += Tcl_UtfToUniChar(format, &ch); objIndex = (int) value - 1; } @@ -691,7 +691,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) */ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ - width = strtoul(format-1, &format, 10); /* INTL: "C" locale. */ + width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */ format += Tcl_UtfToUniChar(format, &ch); } else { width = 0; @@ -703,6 +703,12 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) switch (ch) { case 'l': + if (*format == 'l') { + flags |= SCAN_BIG; + format += 1; + format += Tcl_UtfToUniChar(format, &ch); + break; + } case 'L': flags |= SCAN_LONGER; /* @@ -721,6 +727,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) if (!(flags & SCAN_SUPPRESS)) { objPtr = Tcl_NewIntObj(string - baseString); Tcl_IncrRefCount(objPtr); + CLANG_ASSERT(objs); objs[objIndex++] = objPtr; } nconversions++; @@ -728,49 +735,36 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) case 'd': op = 'i'; - base = 10; - fn = (long (*) _ANSI_ARGS_((char*,void*,int)))strtol; -#ifndef TCL_WIDE_INT_IS_LONG - lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoll; -#endif + parseFlag |= TCL_PARSE_DECIMAL_ONLY; break; case 'i': op = 'i'; - base = 0; - fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtol; -#ifndef TCL_WIDE_INT_IS_LONG - lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoll; -#endif + parseFlag |= TCL_PARSE_SCAN_PREFIXES; break; case 'o': op = 'i'; - base = 8; - fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul; -#ifndef TCL_WIDE_INT_IS_LONG - lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull; -#endif + parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES; break; case 'x': + case 'X': op = 'i'; - base = 16; - fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul; -#ifndef TCL_WIDE_INT_IS_LONG - lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull; -#endif + parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY; + break; + case 'b': + op = 'i'; + parseFlag |= TCL_PARSE_BINARY_ONLY; break; case 'u': op = 'i'; - base = 10; + parseFlag |= TCL_PARSE_DECIMAL_ONLY; flags |= SCAN_UNSIGNED; - fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul; -#ifndef TCL_WIDE_INT_IS_LONG - lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull; -#endif break; case 'f': case 'e': + case 'E': case 'g': + case 'G': op = 'f'; break; @@ -828,7 +822,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) */ if (width == 0) { - width = (size_t) ~0; + width = ~0; } end = string; while (*end != '\0') { @@ -844,6 +838,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) if (!(flags & SCAN_SUPPRESS)) { objPtr = Tcl_NewStringObj(string, end-string); Tcl_IncrRefCount(objPtr); + CLANG_ASSERT(objs); objs[objIndex++] = objPtr; } string = end; @@ -853,7 +848,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) CharSet cset; if (width == 0) { - width = (size_t) ~0; + width = ~0; } end = string; @@ -894,6 +889,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) if (!(flags & SCAN_SUPPRESS)) { objPtr = Tcl_NewIntObj((int)sch); Tcl_IncrRefCount(objPtr); + CLANG_ASSERT(objs); objs[objIndex++] = objPtr; } break; @@ -902,152 +898,60 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) /* * Scan an unsigned or signed integer. */ - - if ((width == 0) || (width > sizeof(buf) - 1)) { - width = sizeof(buf) - 1; + objPtr = Tcl_NewLongObj(0); + Tcl_IncrRefCount(objPtr); + if (width == 0) { + width = ~0; } - flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO; - for (end = buf; width > 0; width--) { - switch (*string) { - /* - * The 0 digit has special meaning at the beginning of a - * number. If we are unsure of the base, it indicates that - * we are in base 8 or base 16 (if it is followed by an - * 'x'). - * - * 8.1 - 8.3.4 incorrectly handled 0x... base-16 cases for - * %x by not reading the 0x as the auto-prelude for - * base-16. [Bug #495213] - */ - case '0': - if (base == 0) { - base = 8; - flags |= SCAN_XOK; - } - if (base == 16) { - flags |= SCAN_XOK; - } - if (flags & SCAN_NOZERO) { - flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO); - } else { - flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS); - } - goto addToInt; - - case '1': case '2': case '3': case '4': - case '5': case '6': case '7': - if (base == 0) { - base = 10; - } - flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS); - goto addToInt; - - case '8': case '9': - if (base == 0) { - base = 10; - } - if (base <= 8) { - break; - } - flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS); - goto addToInt; - - case 'A': case 'B': case 'C': - case 'D': case 'E': case 'F': - case 'a': case 'b': case 'c': - case 'd': case 'e': case 'f': - if (base <= 10) { - break; - } - flags &= ~(SCAN_SIGNOK | SCAN_XOK | SCAN_NODIGITS); - goto addToInt; - - case '+': case '-': - if (flags & SCAN_SIGNOK) { - flags &= ~SCAN_SIGNOK; - goto addToInt; + if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width, + &end, TCL_PARSE_INTEGER_ONLY | parseFlag)) { + Tcl_DecrRefCount(objPtr); + if (width < 0) { + if (*end == '\0') { + underflow = 1; } - break; - - case 'x': case 'X': - if ((flags & SCAN_XOK) && (end == buf+1)) { - base = 16; - flags &= ~SCAN_XOK; - goto addToInt; + } else { + if (end == string + width) { + underflow = 1; } - break; - } - - /* - * We got an illegal character so we are done accumulating. - */ - - break; - - addToInt: - /* - * Add the character to the temporary buffer. - */ - - *end++ = *string++; - if (*string == '\0') { - break; - } - } - - /* - * Check to see if we need to back up because we only got a sign - * or a trailing x after a 0. - */ - - if (flags & SCAN_NODIGITS) { - if (*string == '\0') { - underflow = 1; } goto done; - } else if (end[-1] == 'x' || end[-1] == 'X') { - end--; - string--; } - - /* - * Scan the value from the temporary buffer. If we are returning a - * large unsigned value, we have to convert it back to a string - * since Tcl only supports signed values. - */ - - if (!(flags & SCAN_SUPPRESS)) { - *end = '\0'; -#ifndef TCL_WIDE_INT_IS_LONG - if (flags & SCAN_LONGER) { - wideValue = (Tcl_WideInt) (*lfn)(buf, NULL, base); - if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { - /* INTL: ISO digit */ - sprintf(buf, "%" TCL_LL_MODIFIER "u", - (Tcl_WideUInt)wideValue); - objPtr = Tcl_NewStringObj(buf, -1); - } else { - objPtr = Tcl_NewWideIntObj(wideValue); + string = end; + if (flags & SCAN_SUPPRESS) { + Tcl_DecrRefCount(objPtr); + break; + } + if (flags & SCAN_LONGER) { + if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) { + wideValue = ~(Tcl_WideUInt)0 >> 1; /* WIDE_MAX */ + if (TclGetString(objPtr)[0] == '-') { + wideValue++; /* WIDE_MAX + 1 = WIDE_MIN */ } + } + if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { + sprintf(buf, "%" TCL_LL_MODIFIER "u", + (Tcl_WideUInt)wideValue); + Tcl_SetStringObj(objPtr, buf, -1); } else { -#endif /* !TCL_WIDE_INT_IS_LONG */ - value = (long) (*fn)(buf, NULL, base); - if ((flags & SCAN_UNSIGNED) && (value < 0)) { - sprintf(buf, "%lu", value); /* INTL: ISO digit */ - objPtr = Tcl_NewStringObj(buf, -1); - } else if ((flags & SCAN_LONGER) - || (unsigned long) value > UINT_MAX) { - objPtr = Tcl_NewLongObj(value); + Tcl_SetWideIntObj(objPtr, wideValue); + } + } else if (!(flags & SCAN_BIG)) { + if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) { + if (TclGetString(objPtr)[0] == '-') { + value = LONG_MIN; } else { - objPtr = Tcl_NewIntObj(value); + value = LONG_MAX; } -#ifndef TCL_WIDE_INT_IS_LONG } -#endif - Tcl_IncrRefCount(objPtr); - objs[objIndex++] = objPtr; + if ((flags & SCAN_UNSIGNED) && (value < 0)) { + sprintf(buf, "%lu", value); /* INTL: ISO digit */ + Tcl_SetStringObj(objPtr, buf, -1); + } else { + Tcl_SetLongObj(objPtr, value); + } } - + objs[objIndex++] = objPtr; break; case 'f': @@ -1055,105 +959,45 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) * Scan a floating point number */ - if ((width == 0) || (width > sizeof(buf) - 1)) { - width = sizeof(buf) - 1; + objPtr = Tcl_NewDoubleObj(0.0); + Tcl_IncrRefCount(objPtr); + if (width == 0) { + width = ~0; } - flags &= ~SCAN_LONGER; - flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_PTOK | SCAN_EXPOK; - for (end = buf; width > 0; width--) { - switch (*string) { - case '0': case '1': case '2': case '3': - case '4': case '5': case '6': case '7': - case '8': case '9': - flags &= ~(SCAN_SIGNOK | SCAN_NODIGITS); - goto addToFloat; - case '+': case '-': - if (flags & SCAN_SIGNOK) { - flags &= ~SCAN_SIGNOK; - goto addToFloat; - } - break; - case '.': - if (flags & SCAN_PTOK) { - flags &= ~(SCAN_SIGNOK | SCAN_PTOK); - goto addToFloat; - } - break; - case 'e': case 'E': - /* - * An exponent is not allowed until there has been at - * least one digit. - */ - - if ((flags & (SCAN_NODIGITS | SCAN_EXPOK)) == SCAN_EXPOK) { - flags = (flags & ~(SCAN_EXPOK|SCAN_PTOK)) - | SCAN_SIGNOK | SCAN_NODIGITS; - goto addToFloat; + if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width, + &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) { + Tcl_DecrRefCount(objPtr); + if (width < 0) { + if (*end == '\0') { + underflow = 1; } - break; - } - - /* - * We got an illegal character so we are done accumulating. - */ - - break; - - addToFloat: - /* - * Add the character to the temporary buffer. - */ - - *end++ = *string++; - if (*string == '\0') { - break; - } - } - - /* - * Check to see if we need to back up because we saw a trailing - * 'e' or sign. - */ - - if (flags & SCAN_NODIGITS) { - if (flags & SCAN_EXPOK) { - /* - * There were no digits at all so scanning has failed and - * we are done. - */ - - if (*string == '\0') { + } else { + if (end == string + width) { underflow = 1; } - goto done; - } - - /* - * We got a bad exponent ('e' and maybe a sign). - */ - - end--; - string--; - if (*end != 'e' && *end != 'E') { - end--; - string--; } - } - - /* - * Scan the value from the temporary buffer. - */ - - if (!(flags & SCAN_SUPPRESS)) { + goto done; + } else if (flags & SCAN_SUPPRESS) { + Tcl_DecrRefCount(objPtr); + string = end; + } else { double dvalue; - - *end = '\0'; - dvalue = TclStrToD(buf, NULL); - objPtr = Tcl_NewDoubleObj(dvalue); - Tcl_IncrRefCount(objPtr); + if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) { +#ifdef ACCEPT_NAN + if (objPtr->typePtr == &tclDoubleType) { + dvalue = objPtr->internalRep.doubleValue; + } else +#endif + { + Tcl_DecrRefCount(objPtr); + goto done; + } + } + Tcl_SetDoubleObj(objPtr, dvalue); + CLANG_ASSERT(objs); objs[objIndex++] = objPtr; + string = end; } - break; } nconversions++; } @@ -1172,9 +1016,14 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) continue; } result++; - if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0) == NULL) { - Tcl_AppendResult(interp, "couldn't set variable \"", - TclGetString(objv[i+3]), "\"", (char *) NULL); + + /* + * In case of multiple errors in setting variables, just report + * the first one. + */ + + if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], + (code == TCL_OK) ? TCL_LEAVE_ERR_MSG : 0) == NULL) { code = TCL_ERROR; } Tcl_DecrRefCount(objs[i]); @@ -1200,7 +1049,7 @@ Tcl_ScanObjCmd(dummy, interp, objc, objv) } } if (objs != NULL) { - ckfree((char*) objs); + ckfree(objs); } if (code == TCL_OK) { if (underflow && (nconversions == 0)) { |