diff options
Diffstat (limited to 'generic/tclScan.c')
| -rw-r--r-- | generic/tclScan.c | 111 |
1 files changed, 67 insertions, 44 deletions
diff --git a/generic/tclScan.c b/generic/tclScan.c index f5ec509..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.33 2009/09/07 07:28:38 das Exp $ */ #include "tclInt.h" @@ -45,7 +43,7 @@ typedef struct CharSet { * Declarations for functions used only in this file. */ -static const char * BuildCharSet(CharSet *cset, const char *format); +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, @@ -103,10 +101,9 @@ BuildCharSet( 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; } @@ -226,9 +223,9 @@ static void ReleaseCharSet( CharSet *cset) { - ckfree((char *)cset->chars); + ckfree(cset->chars); if (cset->ranges) { - ckfree((char *)cset->ranges); + ckfree(cset->ranges); } } @@ -262,8 +259,12 @@ ValidateFormat( char *end; Tcl_UniChar ch; int objIndex, xpgSize, nspace = numVars; - int *nassign = (int *) TclStackAlloc(interp, nspace * sizeof(int)); + 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 @@ -331,9 +332,10 @@ ValidateFormat( 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; } @@ -377,9 +379,10 @@ ValidateFormat( 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; } /* @@ -390,9 +393,12 @@ ValidateFormat( if (flags & (SCAN_LONGER|SCAN_BIG)) { invalidFieldSize: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; - Tcl_AppendResult(interp, - "field size 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; } /* @@ -400,17 +406,21 @@ ValidateFormat( */ case 'd': case 'e': + case 'E': case 'f': case 'g': + case 'G': case 'i': case 'o': case 'x': + case 'X': case 'b': break; case 'u': if (flags & SCAN_BIG) { - Tcl_SetResult(interp, - "unsigned bignum scans are invalid", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unsigned bignum scans are invalid", -1)); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL); goto error; } break; @@ -445,18 +455,19 @@ ValidateFormat( } 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) { @@ -472,7 +483,7 @@ ValidateFormat( } else { nspace += 16; /* formerly STATIC_LIST_SIZE */ } - nassign = (int *) TclStackRealloc(interp, nassign, + nassign = TclStackRealloc(interp, nassign, nspace * sizeof(int)); for (i = value; i < nspace; i++) { nassign[i] = 0; @@ -499,9 +510,10 @@ ValidateFormat( } 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)) { /* @@ -509,9 +521,10 @@ ValidateFormat( * 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; } } @@ -521,12 +534,14 @@ ValidateFormat( 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: @@ -554,7 +569,7 @@ ValidateFormat( /* ARGSUSED */ int Tcl_ScanObjCmd( - ClientData dummy, /* Not used. */ + ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -596,7 +611,7 @@ Tcl_ScanObjCmd( */ 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; } @@ -731,6 +746,7 @@ Tcl_ScanObjCmd( parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES; break; case 'x': + case 'X': op = 'i'; parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY; break; @@ -746,7 +762,9 @@ Tcl_ScanObjCmd( case 'f': case 'e': + case 'E': case 'g': + case 'G': op = 'f'; break; @@ -998,9 +1016,14 @@ Tcl_ScanObjCmd( 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]), "\"", 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]); @@ -1026,7 +1049,7 @@ Tcl_ScanObjCmd( } } if (objs != NULL) { - ckfree((char *) objs); + ckfree(objs); } if (code == TCL_OK) { if (underflow && (nconversions == 0)) { @@ -1046,7 +1069,7 @@ Tcl_ScanObjCmd( } return code; } - + /* * Local Variables: * mode: c |