diff options
author | andreas_kupries <andreas_kupries@noemail.net> | 2009-08-25 21:01:05 (GMT) |
---|---|---|
committer | andreas_kupries <andreas_kupries@noemail.net> | 2009-08-25 21:01:05 (GMT) |
commit | eb71c420d2aef684464caadd29de196aa424a551 (patch) | |
tree | 73bcc5c62cbf32fd6429c1116057e7803a5e2c6a /generic/tclParse.c | |
parent | 3e5cab8a0f148cd7f97c115cf9bb7f9d9d7b42da (diff) | |
download | tcl-eb71c420d2aef684464caadd29de196aa424a551.zip tcl-eb71c420d2aef684464caadd29de196aa424a551.tar.gz tcl-eb71c420d2aef684464caadd29de196aa424a551.tar.bz2 |
* generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard,
EvalTokensStandard, Tcl_EvalEx, EvalEx, TclAdvanceContinuations,
TclEvalObjEx):
* generic/tclCmdMZ.c (Tcl_SwitchObjCmd, TclListLines):
* generic/tclCompCmds.c (*):
* generic/tclCompile.c (TclSetByteCodeFromAny, TclInitCompileEnv,
TclFreeCompileEnv, TclCompileScript):
* generic/tclCompile.h (CompileEnv):
* generic/tclInt.h (ContLineLoc, Interp):
* generic/tclObj.c (ThreadSpecificData, ContLineLocFree,
TclThreadFinalizeObjects, TclInitObjSubsystem,
TclContinuationsEnter, TclContinuationsEnterDerived,
TclContinuationsCopy, TclContinuationsGet, TclFreeObj):
* generic/tclParse.c (TclSubstTokens, Tcl_SubstObj):
* generic/tclProc.c (TclCreateProc):
* generic/tclVar.c (TclPtrSetVar):
* tests/info.test (info-30.0-24):
Extended parser, compiler, and execution with code and attendant
data structures tracking the positions of continuation lines which
are not visible in script Tcl_Obj*'s, to properly account for them
while counting lines for #280.
FossilOrigin-Name: c838caae315d224c64d058c46bb9b1de2b84921a
Diffstat (limited to 'generic/tclParse.c')
-rw-r--r-- | generic/tclParse.c | 130 |
1 files changed, 123 insertions, 7 deletions
diff --git a/generic/tclParse.c b/generic/tclParse.c index 769be99..3946511 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -12,7 +12,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.62.2.2 2008/12/01 22:39:59 dgp Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.62.2.3 2009/08/25 21:01:05 andreas_kupries Exp $ */ #include "tclInt.h" @@ -1554,7 +1554,7 @@ Tcl_ParseVar( } code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, - NULL, 1); + NULL, 1, NULL, NULL); TclStackFree(interp, parsePtr); if (code != TCL_OK) { return NULL; @@ -2063,7 +2063,7 @@ Tcl_SubstObj( endTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; tokensLeft = parsePtr->numTokens; code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft, - &tokensLeft, 1); + &tokensLeft, 1, NULL, NULL); if (code == TCL_OK) { Tcl_FreeParse(parsePtr); TclStackFree(interp, parsePtr); @@ -2108,7 +2108,7 @@ Tcl_SubstObj( } code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft, - &tokensLeft, 1); + &tokensLeft, 1, NULL, NULL); } } @@ -2146,10 +2146,31 @@ TclSubstTokens( int *tokensLeftPtr, /* If not NULL, points to memory where an * integer representing the number of tokens * left to be substituted will be written */ - int line) /* The line the script starts on. */ + int line, /* The line the script starts on. */ + int* clNextOuter, /* Information about an outer context for */ + CONST char* outerScript) /* continuation line data. This is set by + * EvalEx() to properly handle [...]-nested + * commands. The 'outerScript' refers to the + * most-outer script containing the embedded + * command, which is refered to by 'script'. The + * 'clNextOuter' refers to the current entry in + * the table of continuation lines in this + * "master script", and the character offsets are + * relative to the 'outerScript' as well. + * + * If outerScript == script, then this call is for + * words in the outer-most script/command. See + * Tcl_EvalEx() and TclEvalObjEx() for the places + * generating arguments for which this is true. + */ { Tcl_Obj *result; int code = TCL_OK; +#define NUM_STATIC_POS 20 + int isLiteral, maxNumCL, numCL, i, adjust; + int* clPosition; + Interp* iPtr = (Interp*) interp; + int inFile = iPtr->evalFlags & TCL_EVAL_FILE; /* * Each pass through this loop will substitute one token, and its @@ -2161,6 +2182,31 @@ TclSubstTokens( * of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them. */ + /* + * For the handling of continuation lines in literals we first check if + * this is actually a literal. For if not we can forego the additional + * processing. Otherwise we pre-allocate a small table to store the + * locations of all continuation lines we find in this literal, if + * any. The table is extended if needed. + */ + + numCL = 0; + maxNumCL = 0; + isLiteral = 1; + for (i=0 ; i < count; i++) { + if ((tokenPtr[i].type != TCL_TOKEN_TEXT) && + (tokenPtr[i].type != TCL_TOKEN_BS)) { + isLiteral = 0; + break; + } + } + + if (isLiteral) { + maxNumCL = NUM_STATIC_POS; + clPosition = (int*) ckalloc (maxNumCL*sizeof(int)); + } + + adjust = 0; result = NULL; for (; count>0 && code==TCL_OK ; count--, tokenPtr++) { Tcl_Obj *appendObj = NULL; @@ -2178,6 +2224,41 @@ TclSubstTokens( appendByteLength = Tcl_UtfBackslash(tokenPtr->start, NULL, utfCharBytes); append = utfCharBytes; + /* + * If the backslash sequence we found is in a literal, and + * represented a continuation line, we compute and store its + * location (as char offset to the beginning of the _result_ + * script). We may have to extend the table of locations. + * + * Note that the continuation line information is relevant even if + * the word we are processing is not a literal, as it can affect + * nested commands. See the branch for TCL_TOKEN_COMMAND below, + * where the adjustment we are tracking here is taken into + * account. The good thing is that we do not need a table of + * everything, just the number of lines we have to add as + * correction. + */ + + if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') && + (tokenPtr->start[1] == '\n')) { + if (isLiteral) { + int clPos; + if (result == 0) { + clPos = 0; + } else { + Tcl_GetStringFromObj(result, &clPos); + } + + if (numCL >= maxNumCL) { + maxNumCL *= 2; + clPosition = (int*) ckrealloc ((char*)clPosition, + maxNumCL*sizeof(int)); + } + clPosition[numCL] = clPos; + numCL ++; + } + adjust ++; + } break; case TCL_TOKEN_COMMAND: { @@ -2186,9 +2267,24 @@ TclSubstTokens( iPtr->numLevels++; code = TclInterpReady(interp); if (code == TCL_OK) { + /* + * Test cases: info-30.{6,8,9} + */ + + int theline; + TclAdvanceContinuations (&line, &clNextOuter, + tokenPtr->start - outerScript); + theline = line + adjust; /* TIP #280: Transfer line information to nested command */ code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, - 0, line); + 0, theline, clNextOuter, outerScript); + /* + * Restore flag reset by nested eval for future bracketed + * commands and their cmdframe setup + */ + if (inFile) { + iPtr->evalFlags |= TCL_EVAL_FILE; + } } iPtr->numLevels--; appendObj = Tcl_GetObjResult(interp); @@ -2205,7 +2301,7 @@ TclSubstTokens( */ code = TclSubstTokens(interp, tokenPtr+2, - tokenPtr->numComponents - 1, NULL, line); + tokenPtr->numComponents - 1, NULL, line, NULL, NULL); arrayIndex = Tcl_GetObjResult(interp); Tcl_IncrRefCount(arrayIndex); } @@ -2289,6 +2385,26 @@ TclSubstTokens( if (code != TCL_ERROR) { /* Keep error message in result! */ if (result != NULL) { Tcl_SetObjResult(interp, result); + /* + * If the code found continuation lines (which implies that this + * word is a literal), then we store the accumulated table of + * locations in the thread-global data structure for the bytecode + * compiler to find later, assuming that the literal is a script + * which will be compiled. + */ + + if (numCL) { + TclContinuationsEnter(result, numCL, clPosition); + } + + /* + * Release the temp table we used to collect the locations of + * continuation lines, if any. + */ + + if (maxNumCL) { + ckfree ((char*) clPosition); + } } else { Tcl_ResetResult(interp); } |