diff options
author | dgp <dgp@users.sourceforge.net> | 2003-03-13 02:48:51 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2003-03-13 02:48:51 (GMT) |
commit | ece28abf02c8eb9f9bd99ae1a5d1b268e2ebef69 (patch) | |
tree | cd5a481ad409b13cc663aa33a74415c55f0e488d /generic/tclBasic.c | |
parent | 40ae076645b787b5f61ab2f9496b6c49ddb7580d (diff) | |
download | tcl-ece28abf02c8eb9f9bd99ae1a5d1b268e2ebef69.zip tcl-ece28abf02c8eb9f9bd99ae1a5d1b268e2ebef69.tar.gz tcl-ece28abf02c8eb9f9bd99ae1a5d1b268e2ebef69.tar.bz2 |
* generic/tclBasic.c (Tcl_EvalTokensStandard):
* generic/tclCmdMZ.c (Tcl_SubstObj):
* generic/tclCompCmds.c (TclCompileSwitchCmd):
* generic/tclCompExpr.c (CompileSubExpr):
* generic/tclCompile.c (TclSetByteCodeFromAny,TclCompileScript,
TclCompileTokens,TclCompileCmdWord):
* generic/tclCompile.h (TclCompileScript):
* generic/tclExecute.c (TclCompEvalObj):
* generic/tclInt.h (Interp,TCL_BRACKET_TERM,TclSubstTokens):
* generic/tclParse.c (ParseTokens,Tcl_SubstObj,TclSubstTokens):
* tests/subst.test (2.4, 8.7, 8.8, 11.4, 11.5):
Substantial refactoring of Tcl_SubstObj to make use of the same
parsing and substitution procedures as normal script evaluation.
Tcl_SubstObj() moved to tclParse.c. New routine TclSubstTokens()
created in tclParse.c which implements all substantial functioning
of Tcl_EvalTokensStandard(). TclCompileScript() loses its
"nested" argument, the Tcl_Interp struct loses its termOffset
field and the TCL_BRACKET_TERM flag in the evalFlags field, all
of which were only used (indirectly) by Tcl_SubstObj(). Tests
subst-8.7,8.8,11.4,11.5 modified to accomodate the only behavior
change: reporting of parse errors now takes precedence over
[return] and [continue] exceptions. All other behavior should
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r-- | generic/tclBasic.c | 261 |
1 files changed, 6 insertions, 255 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 713067c..5315494 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.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: tclBasic.c,v 1.76 2003/03/05 22:31:22 dkf Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.77 2003/03/13 02:48:52 dgp Exp $ */ #include "tclInt.h" @@ -346,7 +346,6 @@ Tcl_CreateInterp() Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; iPtr->cmdCount = 0; - iPtr->termOffset = 0; TclInitLiteralTable(&(iPtr->literalTable)); iPtr->compileEpoch = 0; iPtr->compiledProcPtr = NULL; @@ -3347,143 +3346,7 @@ Tcl_EvalTokensStandard(interp, tokenPtr, count) int count; /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { - Tcl_Obj *resultPtr, *indexPtr, *valuePtr; - char buffer[TCL_UTF_MAX]; -#ifdef TCL_MEM_DEBUG -# define MAX_VAR_CHARS 5 -#else -# define MAX_VAR_CHARS 30 -#endif - char nameBuffer[MAX_VAR_CHARS+1]; - char *varName, *index; - CONST char *p = NULL; /* Initialized to avoid compiler warning. */ - int length, code; - - /* - * The only tricky thing about this procedure is that it attempts to - * avoid object creation and string copying whenever possible. For - * example, if the value is just a nested command, then use the - * command's result object directly. - */ - - code = TCL_OK; - resultPtr = NULL; - Tcl_ResetResult(interp); - for ( ; count > 0; count--, tokenPtr++) { - valuePtr = NULL; - - /* - * The switch statement below computes the next value to be - * concat to the result, as either a range of text or an - * object. - */ - - switch (tokenPtr->type) { - case TCL_TOKEN_TEXT: - p = tokenPtr->start; - length = tokenPtr->size; - break; - - case TCL_TOKEN_BS: - length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, - buffer); - p = buffer; - break; - - case TCL_TOKEN_COMMAND: - code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, - 0); - if (code != TCL_OK) { - goto done; - } - valuePtr = Tcl_GetObjResult(interp); - break; - - case TCL_TOKEN_VARIABLE: - if (tokenPtr->numComponents == 1) { - indexPtr = NULL; - index = NULL; - } else { - code = Tcl_EvalTokensStandard(interp, tokenPtr+2, - tokenPtr->numComponents - 1); - if (code != TCL_OK) { - goto done; - } - indexPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(indexPtr); - index = Tcl_GetString(indexPtr); - } - - /* - * We have to make a copy of the variable name in order - * to have a null-terminated string. We can't make a - * temporary modification to the script to null-terminate - * the name, because a trace callback might potentially - * reuse the script and be affected by the null character. - */ - - if (tokenPtr[1].size <= MAX_VAR_CHARS) { - varName = nameBuffer; - } else { - varName = ckalloc((unsigned) (tokenPtr[1].size + 1)); - } - strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size); - varName[tokenPtr[1].size] = 0; - valuePtr = Tcl_GetVar2Ex(interp, varName, index, - TCL_LEAVE_ERR_MSG); - if (varName != nameBuffer) { - ckfree(varName); - } - if (indexPtr != NULL) { - Tcl_DecrRefCount(indexPtr); - } - if (valuePtr == NULL) { - code = TCL_ERROR; - goto done; - } - count -= tokenPtr->numComponents; - tokenPtr += tokenPtr->numComponents; - break; - - default: - panic("unexpected token type in Tcl_EvalTokensStandard"); - } - - /* - * If valuePtr isn't NULL, the next piece of text comes from that - * object; otherwise, take length bytes starting at p. - */ - - if (resultPtr == NULL) { - if (valuePtr != NULL) { - resultPtr = valuePtr; - } else { - resultPtr = Tcl_NewStringObj(p, length); - } - Tcl_IncrRefCount(resultPtr); - } else { - if (Tcl_IsShared(resultPtr)) { - Tcl_DecrRefCount(resultPtr); - resultPtr = Tcl_DuplicateObj(resultPtr); - Tcl_IncrRefCount(resultPtr); - } - if (valuePtr != NULL) { - p = Tcl_GetStringFromObj(valuePtr, &length); - } - Tcl_AppendToObj(resultPtr, p, length); - } - } - if (resultPtr != NULL) { - Tcl_SetObjResult(interp, resultPtr); - } else { - code = TCL_ERROR; - } - - done: - if (resultPtr != NULL) { - Tcl_DecrRefCount(resultPtr); - } - return code; + return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL); } @@ -3579,7 +3442,7 @@ Tcl_EvalEx(interp, script, numBytes, flags) #define NUM_STATIC_OBJS 20 Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv; Tcl_Token *tokenPtr; - int i, code, commandLength, bytesLeft, nested; + int i, code, commandLength, bytesLeft; CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr * in case TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); @@ -3610,31 +3473,14 @@ Tcl_EvalEx(interp, script, numBytes, flags) objv = staticObjArray; p = script; bytesLeft = numBytes; - if (iPtr->evalFlags & TCL_BRACKET_TERM) { - nested = 1; - } else { - nested = 0; - } iPtr->evalFlags = 0; do { - if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) + if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse) != TCL_OK) { code = TCL_ERROR; goto error; } gotParse = 1; - - if (nested && parse.term == (script + numBytes)) { - /* - * A nested script can only terminate in ']'. If - * the parsing got terminated at the end of the script, - * there was no closing ']'. Report the syntax error. - */ - - code = TCL_ERROR; - goto error; - } - if (parse.numWords > 0) { /* * Generate an array of objects for the words of the command. @@ -3649,8 +3495,8 @@ Tcl_EvalEx(interp, script, numBytes, flags) for (objectsUsed = 0, tokenPtr = parse.tokenPtr; objectsUsed < parse.numWords; objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) { - code = Tcl_EvalTokensStandard(interp, tokenPtr+1, - tokenPtr->numComponents); + code = TclSubstTokens(interp, tokenPtr+1, + tokenPtr->numComponents, NULL); if (code == TCL_OK) { objv[objectsUsed] = Tcl_GetObjResult(interp); Tcl_IncrRefCount(objv[objectsUsed]); @@ -3703,20 +3549,7 @@ Tcl_EvalEx(interp, script, numBytes, flags) p = next; Tcl_FreeParse(&parse); gotParse = 0; - if (nested && (*parse.term == ']')) { - /* - * We get here in the special case where the TCL_BRACKET_TERM - * flag was set in the interpreter and the latest parsed command - * was terminated by the matching close-bracket we seek. - * Return immediately. - */ - - iPtr->termOffset = (p - 1) - script; - iPtr->varFramePtr = savedVarFramePtr; - return TCL_OK; - } } while (bytesLeft > 0); - iPtr->termOffset = p - script; iPtr->varFramePtr = savedVarFramePtr; return TCL_OK; @@ -3753,85 +3586,6 @@ Tcl_EvalEx(interp, script, numBytes, flags) ckfree((char *) objv); } iPtr->varFramePtr = savedVarFramePtr; - - /* - * All that's left to do before returning is to set iPtr->termOffset - * to point past the end of the script we just evaluated. - */ - - next = parse.commandStart + parse.commandSize; - bytesLeft -= next - p; - p = next; - - if (!nested) { - iPtr->termOffset = p - script; - return code; - } - - /* - * When we are nested (the TCL_BRACKET_TERM flag was set in the - * interpreter), we must find the matching close-bracket to - * end the script we are evaluating. - * - * When our return code is TCL_CONTINUE or TCL_RETURN, we want - * to correctly set iPtr->termOffset to point to that matching - * close-bracket so our caller can move to the part of the - * string beyond the script we were asked to evaluate. - * So we try to parse past the rest of the commands. - */ - - next = NULL; - while (bytesLeft && (*parse.term != ']')) { - if (TCL_OK != Tcl_ParseCommand(NULL, p, bytesLeft, 1, &parse)) { - /* - * Syntax error. Set the termOffset to the beginning of - * the last command parsed. - */ - - if (next == NULL) { - iPtr->termOffset = (parse.commandStart - 1) - script; - } else { - iPtr->termOffset = (next - 1) - script; - } - return code; - } - next = parse.commandStart + parse.commandSize; - bytesLeft -= next - p; - p = next; - next = parse.commandStart; - Tcl_FreeParse(&parse); - } - - if (bytesLeft) { - /* - * parse.term points to the close-bracket. - */ - - iPtr->termOffset = parse.term - script; - } else if (parse.term == script + numBytes) { - /* - * There was no close-bracket. Syntax error. - */ - - iPtr->termOffset = parse.term - script; - Tcl_SetObjResult(interp, - Tcl_NewStringObj("missing close-bracket", -1)); - return TCL_ERROR; - } else if (*parse.term != ']') { - /* - * There was no close-bracket. Syntax error. - */ - - iPtr->termOffset = (parse.term + 1) - script; - Tcl_SetObjResult(interp, - Tcl_NewStringObj("missing close-bracket", -1)); - return TCL_ERROR; - } else { - /* - * parse.term points to the close-bracket. - */ - iPtr->termOffset = parse.term - script; - } return code; } @@ -3933,9 +3687,6 @@ Tcl_GlobalEvalObj(interp, objPtr) * commands will almost certainly have side effects that depend * on those commands. * - * Just as in Tcl_Eval, interp->termOffset is set to the offset of the - * last character executed in the objPtr's string. - * *---------------------------------------------------------------------- */ |