Overview
| Artifact ID: | da6813daebf5a1219a0fd23c221569d15d73cea8 |
|---|---|
| Ticket: | 455151ffffffffffffffffffffffffffffffffff |
| Date: | 2001-09-13 01:21:47 |
| User: | msofer |
| Artifact Attached: | 1b3578d56ffd58ecb6909355374acd93b857165c |
| Filename: | patch455151.txt |
| Description: | updated patch |
Content:
Index: ChangeLog =================================================================== RCS file: /cvsroot/tcl/tcl/ChangeLog,v retrieving revision 1.603 diff -u -r1.603 ChangeLog --- ChangeLog 2001/09/12 16:32:21 1.603 +++ ChangeLog 2001/09/12 18:14:05 @@ -1,3 +1,17 @@ +2001-08-28 Miguel Sofer <[email protected]> + + * doc/ParseCmd.3: + * generic/tcl.decls: + * generic/tclCmdMZ.c (Tcl_SubstObjCmd): + * generic/tclDecls.h: + * generic/tclParse.c: + * generic/tclStubInit.c: + * tests/parse.test: Deprecate the use of Tcl_EvalTokens, replaced + by the new Tcl_EvalTokensStandard. The new function performs the + same duties but adheres to the standard return convention for Tcl + evaluations; the deprecated function could only return TCL_OK or + TCL_ERROR, which caused [Bug: 219384] and [Bug: 455151]. + 2001-09-12 Miguel Sofer <[email protected]> * generic/tcl.decls: reserved stub #481 for the implementation of Index: doc/ParseCmd.3 =================================================================== RCS file: /cvsroot/tcl/tcl/doc/ParseCmd.3,v retrieving revision 1.4 diff -u -r1.4 ParseCmd.3 --- doc/ParseCmd.3 2000/04/24 23:53:03 1.4 +++ doc/ParseCmd.3 2001/09/12 18:14:06 @@ -10,7 +10,9 @@ .TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens \- parse Tcl scripts and expressions +Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, +Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, +Tcl_EvalTokens, BTcl_EvalTokensStandard \- parse Tcl scripts and expressions .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -37,13 +39,17 @@ .sp Tcl_Obj * \fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR) +.sp +Tcl_Obj * +\fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR) .SH ARGUMENTS .AS Tcl_Interp *usedParsePtr .AP Tcl_Interp *interp out -For procedures other than \fBTcl_FreeParse\fR and \fBTcl_EvalTokens\fR, -used only for error reporting; +For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR +and \fBTcl_EvalTokensStandard\fR, used only for error reporting; if NULL, then no error messages are left after errors. -For \fBTcl_EvalTokens\fR, determines the context for evaluating the +For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR, +determines the context for evaluating the script and also is used for error reporting; must not be NULL. .AP char *string in Pointer to first character in string to parse. @@ -178,18 +184,27 @@ so if repeated calls are being made to any of them then \fBTcl_FreeParse\fR must be invoked once after each call. .PP -\fBTcl_EvalTokens\fR evaluates a sequence of parse tokens from a Tcl_Parse -structure. The tokens typically consist +\fBTcl_EvalTokensStandard\fR evaluates a sequence of parse tokens from +a Tcl_Parse structure. The tokens typically consist of all the tokens in a word or all the tokens that make up the index for -a reference to an array variable. \fBTcl_EvalTokens\fR performs the -substitutions requested by the tokens, concatenates the -resulting values, and returns the result in a new Tcl_Obj. The -reference count of the object returned as result has been +a reference to an array variable. \fBTcl_EvalTokensStandard\fR performs the +substitutions requested by the tokens and concatenates the +resulting values. +The return value from \fBTcl_EvalTokensStandard\fR is a Tcl completion +code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, +\fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR. +In addition, a result value or error message is left in \fIinterp\fR's +result; it can be retrieved using \fBTcl_GetObjResult\fR. +.PP +\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in +the return convention used: it returns the result in a new Tcl_Obj. +The reference count of the object returned as result has been incremented, so the caller must invoke \fBTcl_DecrRefCount\fR when it is finished with the object. -If an error occurs while evaluating the tokens (such as a reference to -a non-existent variable) then the return value is NULL and an error -message is left in \fIinterp\fR's result. +If an error or other exception occurs while evaluating the tokens +(such as a reference to a non-existent variable) then the return value +is NULL and an error message is left in \fIinterp\fR's result. The use +of \fBTcl_EvalTokens\fR is deprecated. .SH "TCL_PARSE STRUCTURE" .PP Index: generic/tcl.decls =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v retrieving revision 1.57 diff -u -r1.57 tcl.decls --- generic/tcl.decls 2001/09/12 16:32:21 1.57 +++ generic/tcl.decls 2001/09/12 18:14:08 @@ -1682,9 +1682,9 @@ void Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr) } # New function due to TIP#56 -#declare 481 generic { -# int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count) -#} +declare 481 generic { + int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count) +} ############################################################################## Index: generic/tclCmdMZ.c =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v retrieving revision 1.43 diff -u -r1.43 tclCmdMZ.c --- generic/tclCmdMZ.c 2001/08/07 00:56:15 1.43 +++ generic/tclCmdMZ.c 2001/09/12 18:14:10 @@ -2371,7 +2371,7 @@ case '$': if (flags & TCL_SUBST_VARIABLES) { Tcl_Parse parse; - Tcl_Obj *tempObj; + int code; /* * Code is simpler overall if we (effectively) inline @@ -2398,13 +2398,13 @@ Tcl_AppendToObj(resultObj, old, p-old); } p += parse.tokenPtr->size; - tempObj = Tcl_EvalTokens(interp, parse.tokenPtr, - parse.numTokens); - if (tempObj == NULL) { + code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, + parse.numTokens); + if (code != TCL_OK) { goto errorResult; } - Tcl_AppendObjToObj(resultObj, tempObj); - Tcl_DecrRefCount(tempObj); + Tcl_AppendObjToObj(resultObj, Tcl_GetObjResult(interp)); + Tcl_ResetResult(interp); old = p; } else { p++; Index: generic/tclDecls.h =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v retrieving revision 1.57 diff -u -r1.57 tclDecls.h --- generic/tclDecls.h 2001/09/06 17:51:00 1.57 +++ generic/tclDecls.h 2001/09/12 18:14:14 @@ -1500,6 +1500,10 @@ /* 480 */ EXTERN void Tcl_FSMountsChanged _ANSI_ARGS_(( Tcl_Filesystem * fsPtr)); +/* 481 */ +EXTERN int Tcl_EvalTokensStandard _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Token * tokenPtr, + int count)); typedef struct TclStubHooks { struct TclPlatStubs *tclPlatStubs; @@ -2040,6 +2044,7 @@ Tcl_PathType (*tcl_FSGetPathType) _ANSI_ARGS_((Tcl_Obj * pathObjPtr)); /* 478 */ int (*tcl_OutputBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 479 */ void (*tcl_FSMountsChanged) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 480 */ + int (*tcl_EvalTokensStandard) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 481 */ } TclStubs; #ifdef __cplusplus @@ -4003,6 +4008,10 @@ #ifndef Tcl_FSMountsChanged #define Tcl_FSMountsChanged \ (tclStubsPtr->tcl_FSMountsChanged) /* 480 */ +#endif +#ifndef Tcl_EvalTokensStandard +#define Tcl_EvalTokensStandard \ + (tclStubsPtr->tcl_EvalTokensStandard) /* 481 */ #endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ Index: generic/tclParse.c =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclParse.c,v retrieving revision 1.15 diff -u -r1.15 tclParse.c --- generic/tclParse.c 2001/05/03 21:14:57 1.15 +++ generic/tclParse.c 2001/09/12 18:14:16 @@ -1117,28 +1117,26 @@ /* *---------------------------------------------------------------------- * - * Tcl_EvalTokens -- + * Tcl_EvalTokensStandard -- * * Given an array of tokens parsed from a Tcl command (e.g., the * tokens that make up a word or the index for an array variable) * this procedure evaluates the tokens and concatenates their * values to form a single result value. - * + * * Results: - * The return value is a pointer to a newly allocated Tcl_Obj - * containing the value of the array of tokens. The reference - * count of the returned object has been incremented. If an error - * occurs in evaluating the tokens then a NULL value is returned - * and an error message is left in interp's result. + * The return value is a standard Tcl completion code such as + * TCL_OK or TCL_ERROR. A result or error message is left in + * interp's result. * * Side effects: - * A new object is allocated to hold the result. - * + * Depends on the array of tokens being evaled. + * *---------------------------------------------------------------------- */ -Tcl_Obj * -Tcl_EvalTokens(interp, tokenPtr, count) +int +Tcl_EvalTokensStandard(interp, tokenPtr, count) Tcl_Interp *interp; /* Interpreter in which to lookup * variables, execute nested commands, * and report errors. */ @@ -1166,7 +1164,9 @@ * command's result object directly. */ + code = TCL_OK; resultPtr = NULL; + Tcl_ResetResult(interp); for ( ; count > 0; count--, tokenPtr++) { valuePtr = NULL; @@ -1192,7 +1192,7 @@ code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, 0); if (code != TCL_OK) { - goto error; + goto done; } valuePtr = Tcl_GetObjResult(interp); break; @@ -1200,12 +1200,16 @@ case TCL_TOKEN_VARIABLE: if (tokenPtr->numComponents == 1) { indexPtr = NULL; + index = NULL; } else { - indexPtr = Tcl_EvalTokens(interp, tokenPtr+2, + code = Tcl_EvalTokensStandard(interp, tokenPtr+2, tokenPtr->numComponents - 1); - if (indexPtr == NULL) { - goto error; + if (code != TCL_OK) { + goto done; } + indexPtr = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(indexPtr); + index = Tcl_GetString(indexPtr); } /* @@ -1223,11 +1227,6 @@ } strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size); varName[tokenPtr[1].size] = 0; - if (indexPtr != NULL) { - index = TclGetString(indexPtr); - } else { - index = NULL; - } valuePtr = Tcl_GetVar2Ex(interp, varName, index, TCL_LEAVE_ERR_MSG); if (varName != nameBuffer) { @@ -1237,14 +1236,15 @@ Tcl_DecrRefCount(indexPtr); } if (valuePtr == NULL) { - goto error; + code = TCL_ERROR; + goto done; } count -= tokenPtr->numComponents; tokenPtr += tokenPtr->numComponents; break; default: - panic("unexpected token type in Tcl_EvalTokens"); + panic("unexpected token type in Tcl_EvalTokensStandard"); } /* @@ -1272,14 +1272,69 @@ Tcl_AppendToObj(resultPtr, p, length); } } - return resultPtr; - - error: if (resultPtr != NULL) { + Tcl_SetObjResult(interp, resultPtr); Tcl_DecrRefCount(resultPtr); + } else { + code = TCL_ERROR; } - return NULL; + + done: + return code; } + + +/* + *---------------------------------------------------------------------- + * + * Tcl_EvalTokens -- + * + * Given an array of tokens parsed from a Tcl command (e.g., the + * tokens that make up a word or the index for an array variable) + * this procedure evaluates the tokens and concatenates their + * values to form a single result value. + * + * Results: + * The return value is a pointer to a newly allocated Tcl_Obj + * containing the value of the array of tokens. The reference + * count of the returned object has been incremented. If an error + * occurs in evaluating the tokens then a NULL value is returned + * and an error message is left in interp's result. + * + * Side effects: + * A new object is allocated to hold the result. + * + *---------------------------------------------------------------------- + * + * This uses a non-standard return convention; its use is now deprecated. + * It is a wrapper for the new function Tcl_EvalTokensStandard, and is not + * used in the core any longer. It is only kept for backward compatibility. + */ + +Tcl_Obj * +Tcl_EvalTokens(interp, tokenPtr, count) + Tcl_Interp *interp; /* Interpreter in which to lookup + * variables, execute nested commands, + * and report errors. */ + Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens + * to evaluate and concatenate. */ + int count; /* Number of tokens to consider at tokenPtr. + * Must be at least 1. */ +{ + int code; + Tcl_Obj *resPtr; + + code = Tcl_EvalTokensStandard(interp, tokenPtr, count); + if (code == TCL_OK) { + resPtr = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(resPtr); + Tcl_ResetResult(interp); + return resPtr; + } else { + return NULL; + } +} + /* *---------------------------------------------------------------------- @@ -1378,10 +1433,12 @@ for (objectsUsed = 0, tokenPtr = parse.tokenPtr; objectsUsed < parse.numWords; objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) { - objv[objectsUsed] = Tcl_EvalTokens(interp, tokenPtr+1, - tokenPtr->numComponents); - if (objv[objectsUsed] == NULL) { - code = TCL_ERROR; + code = Tcl_EvalTokensStandard(interp, tokenPtr+1, + tokenPtr->numComponents); + if (code == TCL_OK) { + objv[objectsUsed] = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(objv[objectsUsed]); + } else { goto error; } } @@ -1841,6 +1898,7 @@ { Tcl_Parse parse; register Tcl_Obj *objPtr; + int code; if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) { return NULL; @@ -1857,22 +1915,19 @@ return "$"; } - objPtr = Tcl_EvalTokens(interp, parse.tokenPtr, parse.numTokens); - if (objPtr == NULL) { + code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, parse.numTokens); + if (code != TCL_OK) { return NULL; } + objPtr = Tcl_GetObjResult(interp); /* * At this point we should have an object containing the value of * a variable. Just return the string from that object. */ -#ifdef TCL_COMPILE_DEBUG - if (objPtr->refCount < 2) { - panic("Tcl_ParseVar got temporary object from Tcl_EvalTokens"); - } -#endif /*TCL_COMPILE_DEBUG*/ - TclDecrRefCount(objPtr); + Tcl_IncrRefCount(objPtr); + Tcl_ResetResult(interp); return TclGetString(objPtr); } Index: generic/tclStubInit.c =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v retrieving revision 1.60 diff -u -r1.60 tclStubInit.c --- generic/tclStubInit.c 2001/09/10 17:17:41 1.60 +++ generic/tclStubInit.c 2001/09/12 18:14:17 @@ -878,6 +878,7 @@ Tcl_FSGetPathType, /* 478 */ Tcl_OutputBuffered, /* 479 */ Tcl_FSMountsChanged, /* 480 */ + Tcl_EvalTokensStandard, /* 481 */ }; /* !END!: Do not edit above this line. */ Index: tests/parse.test =================================================================== RCS file: /cvsroot/tcl/tcl/tests/parse.test,v retrieving revision 1.7 diff -u -r1.7 parse.test --- tests/parse.test 2000/04/10 17:19:02 1.7 +++ tests/parse.test 2001/09/12 18:14:17 @@ -732,6 +732,10 @@ subst {[eval {return foo}]bar} } foobar +test parse-17.1 {Correct return codes from errors during substitution} { + catch {eval {w[continue]}} +} 4 + # cleanup catch {unset a} ::tcltest::cleanupTests