summaryrefslogtreecommitdiffstats
path: root/generic/tclParse.c
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2009-08-25 21:01:05 (GMT)
committerandreas_kupries <akupries@shaw.ca>2009-08-25 21:01:05 (GMT)
commitb323d4f47679f5fc047d6397a0c87f0768de644c (patch)
tree73bcc5c62cbf32fd6429c1116057e7803a5e2c6a /generic/tclParse.c
parent07abfaa1257d10162ab31f3e2e113c192650e2d8 (diff)
downloadtcl-b323d4f47679f5fc047d6397a0c87f0768de644c.zip
tcl-b323d4f47679f5fc047d6397a0c87f0768de644c.tar.gz
tcl-b323d4f47679f5fc047d6397a0c87f0768de644c.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.
Diffstat (limited to 'generic/tclParse.c')
-rw-r--r--generic/tclParse.c130
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);
}