diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tcl.decls | 8 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 14 | ||||
| -rw-r--r-- | generic/tclDecls.h | 11 | ||||
| -rw-r--r-- | generic/tclParse.c | 133 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 3 |
5 files changed, 117 insertions, 52 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 486c9e2..b53bdad 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.57 2001/09/12 16:32:21 msofer Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.58 2001/09/13 11:56:19 msofer Exp $ library tcl @@ -1682,9 +1682,9 @@ declare 480 generic { 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) +} ############################################################################## diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 2d1446b..108d931 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -13,7 +13,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.43 2001/08/07 00:56:15 hobbs Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.44 2001/09/13 11:56:19 msofer Exp $ */ #include "tclInt.h" @@ -2371,7 +2371,7 @@ Tcl_SubstObj(interp, objPtr, flags) 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_SubstObj(interp, objPtr, flags) 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++; diff --git a/generic/tclDecls.h b/generic/tclDecls.h index ca2d0f1..9670564 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDecls.h,v 1.57 2001/09/06 17:51:00 vincentdarley Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.58 2001/09/13 11:56:19 msofer Exp $ */ #ifndef _TCLDECLS @@ -1500,6 +1500,10 @@ EXTERN int Tcl_OutputBuffered _ANSI_ARGS_((Tcl_Channel chan)); /* 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 @@ typedef struct TclStubs { 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 @@ -4004,6 +4009,10 @@ extern TclStubs *tclStubsPtr; #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) */ diff --git a/generic/tclParse.c b/generic/tclParse.c index de62df8..a6eaab3 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParse.c,v 1.15 2001/05/03 21:14:57 msofer Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.16 2001/09/13 11:56:20 msofer Exp $ */ #include "tclInt.h" @@ -1117,28 +1117,26 @@ Tcl_LogCommandInfo(interp, script, command, length) /* *---------------------------------------------------------------------- * - * 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 @@ Tcl_EvalTokens(interp, tokenPtr, count) * command's result object directly. */ + code = TCL_OK; resultPtr = NULL; + Tcl_ResetResult(interp); for ( ; count > 0; count--, tokenPtr++) { valuePtr = NULL; @@ -1192,7 +1192,7 @@ Tcl_EvalTokens(interp, tokenPtr, count) 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 @@ Tcl_EvalTokens(interp, tokenPtr, count) 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 @@ Tcl_EvalTokens(interp, tokenPtr, count) } 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_EvalTokens(interp, tokenPtr, count) 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_EvalTokens(interp, tokenPtr, count) Tcl_AppendToObj(resultPtr, p, length); } } - return resultPtr; - - error: if (resultPtr != NULL) { + Tcl_SetObjResult(interp, resultPtr); Tcl_DecrRefCount(resultPtr); + } else { + code = TCL_ERROR; + } + + 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; } - return NULL; } + /* *---------------------------------------------------------------------- @@ -1378,10 +1433,12 @@ Tcl_EvalEx(interp, script, numBytes, flags) 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_ParseVar(interp, string, termPtr) { 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 @@ Tcl_ParseVar(interp, string, termPtr) 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); } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 900979a..2a1fbfb 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStubInit.c,v 1.60 2001/09/10 17:17:41 andreas_kupries Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.61 2001/09/13 11:56:20 msofer Exp $ */ #include "tclInt.h" @@ -878,6 +878,7 @@ TclStubs tclStubs = { Tcl_FSGetPathType, /* 478 */ Tcl_OutputBuffered, /* 479 */ Tcl_FSMountsChanged, /* 480 */ + Tcl_EvalTokensStandard, /* 481 */ }; /* !END!: Do not edit above this line. */ |