summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog24
-rw-r--r--generic/tclBasic.c162
-rw-r--r--generic/tclCmdMZ.c27
-rw-r--r--generic/tclCompCmds.c113
-rw-r--r--generic/tclCompile.c156
-rw-r--r--generic/tclCompile.h12
-rw-r--r--generic/tclInt.h57
-rw-r--r--generic/tclObj.c400
-rw-r--r--generic/tclParse.c131
-rw-r--r--generic/tclProc.c14
-rw-r--r--generic/tclVar.c5
-rw-r--r--tests/info.test297
12 files changed, 1288 insertions, 110 deletions
diff --git a/ChangeLog b/ChangeLog
index df090b8..2b3e396 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+2009-08-25 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard,
+ Tcl_EvalEx, TclEvalEx, TclAdvanceContinuations, TclNREvalObjEx):
+ * generic/tclCmdMZ.c (Tcl_SwitchObjCmd, TclListLines):
+ * generic/tclCompCmds.c (*):
+ * generic/tclCompile.c (TclSetByteCodeFromAny, TclInitCompileEnv,
+ TclFreeCompileEnv, TclCompileScript, TclCompileTokens):
+ * 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 the parser, compiler, and execution engine with code and
+ attendant data structures tracking the position of continuation
+ lines which are not visible in the resulting script Tcl_Obj*'s, to
+ properly account for them while counting lines for #280.
+
2009-08-24 Daniel Steffen <das@users.sourceforge.net>
* generic/tclInt.h: Annotate Tcl_Panic as noreturn for clang static
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b83afe5..d97194c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,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.401 2009/08/12 16:06:41 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.402 2009/08/25 21:03:25 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -522,6 +522,7 @@ Tcl_CreateInterp(void)
Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
+ iPtr->scriptCLLocPtr = NULL;
iPtr->activeVarTracePtr = NULL;
@@ -4767,7 +4768,8 @@ Tcl_EvalTokensStandard(
int count) /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
{
- return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1);
+ return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
+ NULL, NULL);
}
/*
@@ -4851,7 +4853,7 @@ Tcl_EvalEx(
* evaluation of the script. Only
* TCL_EVAL_GLOBAL is currently supported. */
{
- return TclEvalEx(interp, script, numBytes, flags, 1);
+ return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
}
int
@@ -4865,7 +4867,24 @@ TclEvalEx(
int flags, /* Collection of OR-ed bits that control the
* evaluation of the script. Only
* TCL_EVAL_GLOBAL is currently supported. */
- 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 only in
+ * EvalTokensStandard(), 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 the outer-most script/command. See
+ * Tcl_EvalEx() and TclEvalObjEx() for places
+ * generating arguments for which this is true.
+ */
{
Interp *iPtr = (Interp *) interp;
const char *p, *next;
@@ -4891,6 +4910,23 @@ TclEvalEx(
int *linesStack = TclStackAlloc(interp, minObjs * sizeof(int));
/* TIP #280 Structures for tracking of command
* locations. */
+ /*
+ * Pointer for the tracking of invisible continuation lines. Initialized
+ * only if the caller gave us a table of locations to track, via
+ * scriptCLLocPtr. It always refers to the table entry holding the
+ * location of the next invisible continuation line to look for, while
+ * parsing the script.
+ */
+
+ int* clNext = NULL;
+
+ if (iPtr->scriptCLLocPtr) {
+ if (clNextOuter) {
+ clNext = clNextOuter;
+ } else {
+ clNext = &iPtr->scriptCLLocPtr->loc[0];
+ }
+ }
if (numBytes < 0) {
numBytes = strlen(script);
@@ -4916,12 +4952,12 @@ TclEvalEx(
/*
* TIP #280 Initialize tracking. Do not push on the frame stack yet.
*
- * We may cont. counting based on a specific context (CTX), or open a new
- * context, either for a sourced script, or 'eval'. For sourced files we
- * always have a path object, even if nothing was specified in the interp
- * itself. That makes code using it simpler as NULL checks can be left
- * out. Sourced file without path in the 'scriptFile' is possible during
- * Tcl initialization.
+ * We may continue counting based on a specific context (CTX), or open a
+ * new context, either for a sourced script, or 'eval'. For sourced files
+ * we always have a path object, even if nothing was specified in the
+ * interp itself. That makes code using it simpler as NULL checks can be
+ * left out. Sourced file without path in the 'scriptFile' is possible
+ * during Tcl initialization.
*/
eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
@@ -4989,19 +5025,25 @@ TclEvalEx(
/*
* TIP #280 Track lines. The parser may have skipped text till it
* found the command we are now at. We have to count the lines in this
- * block.
+ * block, and do not forget invisible continuation lines.
*/
TclAdvanceLines(&line, p, parsePtr->commandStart);
+ TclAdvanceContinuations (&line, &clNext,
+ parsePtr->commandStart - outerScript);
gotParse = 1;
if (parsePtr->numWords > 0) {
/*
- * TIP #280. Track lines within the words of the current command.
+ * TIP #280. Track lines within the words of the current
+ * command. We use a separate pointer into the table of
+ * continuation line locations to not lose our position for the
+ * per-command parsing.
*/
int wordLine = line;
const char *wordStart = parsePtr->commandStart;
+ int* wordCLNext = clNext;
/*
* Generate an array of objects for the words of the command.
@@ -5033,6 +5075,8 @@ TclEvalEx(
*/
TclAdvanceLines(&wordLine, wordStart, tokenPtr->start);
+ TclAdvanceContinuations (&wordLine, &wordCLNext,
+ tokenPtr->start - outerScript);
wordStart = tokenPtr->start;
lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
@@ -5043,7 +5087,8 @@ TclEvalEx(
}
code = TclSubstTokens(interp, tokenPtr+1,
- tokenPtr->numComponents, NULL, wordLine);
+ tokenPtr->numComponents, NULL, wordLine,
+ wordCLNext, outerScript);
iPtr->evalFlags = 0;
@@ -5075,6 +5120,11 @@ TclEvalEx(
expand[objectsUsed] = 0;
objectsNeeded++;
}
+
+ if (wordCLNext) {
+ TclContinuationsEnterDerived (objv[objectsUsed],
+ wordStart - outerScript, wordCLNext);
+ }
} /* for loop */
iPtr->cmdFramePtr = eeFramePtr;
if (code != TCL_OK) {
@@ -5302,6 +5352,53 @@ TclAdvanceLines(
/*
*----------------------------------------------------------------------
+ *
+ * TclAdvanceContinuations --
+ *
+ * This procedure is a helper which counts the number of continuation
+ * lines (CL) in a block of text using a table of CL locations and
+ * advances an external counter, and the pointer into the table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The specified counter is advanced per the number of continuation lines
+ * found.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclAdvanceContinuations (line,clNextPtrPtr,loc)
+ int* line;
+ int** clNextPtrPtr;
+ int loc;
+{
+ /*
+ * Track the invisible continuation lines embedded in a script, if
+ * any. Here they are just spaces (already). They were removed by
+ * EvalTokensStandard() via Tcl_UtfBackslash().
+ *
+ * *clNextPtrPtr <=> We have continuation lines to track.
+ * **clNextPtrPtr >= 0 <=> We are not beyond the last possible location.
+ * loc >= **clNextPtrPtr <=> We stepped beyond the current cont. line.
+ */
+
+ while (*clNextPtrPtr && (**clNextPtrPtr >= 0) && (loc >= **clNextPtrPtr)) {
+ /*
+ * We just stepped over an invisible continuation line. Adjust the
+ * line counter and step to the table entry holding the location of
+ * the next continuation line to track.
+ */
+ (*line) ++;
+ (*clNextPtrPtr) ++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
* Note: The whole data structure access for argument location tracking is
* hidden behind these three functions. The only parts open are the lineLAPtr
* field in the Interp structure. The CFWord definition is internal to here.
@@ -5919,6 +6016,33 @@ TclNREvalObjEx(
const char *script;
int numSrcBytes;
+ /*
+ * Now we check if we have data about invisible continuation lines for
+ * the script, and make it available to the direct script parser and
+ * evaluator we are about to call, if so.
+ *
+ * It may be possible that the script Tcl_Obj* can be free'd while the
+ * evaluator is using it, leading to the release of the associated
+ * ContLineLoc structure as well. To ensure that the latter doesn't
+ * happen we set a lock on it. We release this lock later in this
+ * function, after the evaluator is done. The relevant "lineCLPtr"
+ * hashtable is managed in the file "tclObj.c".
+ *
+ * Another important action is to save (and later restore) the
+ * continuation line information of the caller, in case we are
+ * executing nested commands in the eval/direct path.
+ */
+
+ ContLineLoc* saveCLLocPtr = iPtr->scriptCLLocPtr;
+ ContLineLoc* clLocPtr = TclContinuationsGet (objPtr);
+
+ if (clLocPtr) {
+ iPtr->scriptCLLocPtr = clLocPtr;
+ Tcl_Preserve (iPtr->scriptCLLocPtr);
+ } else {
+ iPtr->scriptCLLocPtr = NULL;
+ }
+
Tcl_IncrRefCount(objPtr);
if (invoker == NULL) {
/*
@@ -5974,7 +6098,7 @@ TclNREvalObjEx(
iPtr->evalFlags |= TCL_EVAL_CTX;
result = TclEvalEx(interp, script, numSrcBytes, flags,
- ctxPtr->line[word]);
+ ctxPtr->line[word], NULL, script);
if (pc) {
/*
@@ -5985,6 +6109,16 @@ TclNREvalObjEx(
}
}
TclStackFree(interp, ctxPtr);
+
+ /*
+ * Now release the lock on the continuation line information, if
+ * any, and restore the caller's settings.
+ */
+
+ if (iPtr->scriptCLLocPtr) {
+ Tcl_Release (iPtr->scriptCLLocPtr);
+ }
+ iPtr->scriptCLLocPtr = saveCLLocPtr;
}
TclDecrRefCount(objPtr);
return result;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 706b905..2cce7be 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,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.190 2009/08/20 10:55:51 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.191 2009/08/25 21:03:25 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -3853,7 +3853,7 @@ TclNRSwitchObjCmd(
ctxPtr->line = (int *) ckalloc(objc * sizeof(int));
ctxPtr->nline = objc;
- TclListLines(TclGetString(blist), bline, objc, ctxPtr->line);
+ TclListLines(blist, bline, objc, ctxPtr->line, objv);
} else {
/*
* This is either a dynamic code word, when all elements are
@@ -3893,7 +3893,7 @@ TclNRSwitchObjCmd(
Tcl_NRAddCallback(interp, SwitchPostProc, INT2PTR(splitObjs), ctxPtr,
INT2PTR(pc), (ClientData) pattern);
- return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, j);
+ return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j);
}
static int
SwitchPostProc(
@@ -4701,21 +4701,34 @@ TclNRWhileObjCmd(
void
TclListLines(
- const char *listStr, /* Pointer to string with list structure.
- * Assumed to be valid. Assumed to contain n
- * elements. */
+ Tcl_Obj* listObj, /* Pointer to obj holding a string with list
+ * structure. Assumed to be valid. Assumed to
+ * contain n elements.
+ */
int line, /* Line the list as a whole starts on. */
int n, /* #elements in lines */
- int *lines) /* Array of line numbers, to fill. */
+ int *lines, /* Array of line numbers, to fill. */
+ Tcl_Obj* const* elems) /* The list elems as Tcl_Obj*, in need of
+ * derived continuation data */
{
+ CONST char* listStr = Tcl_GetString (listObj);
+ CONST char* listHead = listStr;
int i, length = strlen(listStr);
const char *element = NULL, *next = NULL;
+ ContLineLoc* clLocPtr = TclContinuationsGet(listObj);
+ int* clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
for (i = 0; i < n; i++) {
TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
TclAdvanceLines(&line, listStr, element);
/* Leading whitespace */
+ TclAdvanceContinuations (&line, &clNext, element - listHead);
+ if (elems && clNext) {
+ TclContinuationsEnterDerived (elems[i],
+ element - listHead,
+ clNext);
+ }
lines[i] = line;
length -= (next - listStr);
TclAdvanceLines(&line, element, next);
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 8403a98..5b5871f 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.152 2009/02/03 23:34:32 nijtmans Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.153 2009/08/25 21:03:25 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -32,6 +32,7 @@
(tokenPtr)[1].size), (envPtr)); \
} else { \
envPtr->line = mapPtr->loc[eclIndex].line[word]; \
+ envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \
TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
(envPtr)); \
}
@@ -49,6 +50,10 @@
ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \
int eclIndex = mapPtr->nuloc - 1
+#define SetLineInformation(word) \
+ envPtr->line = mapPtr->loc [eclIndex].line [(word)]; \
+ envPtr->clNext = mapPtr->loc [eclIndex].next [(word)]
+
/*
* Convenience macro for use when compiling bodies of commands. The ANSI C
* "prototype" for this macro is:
@@ -160,7 +165,8 @@ static void PrintJumptableInfo(ClientData clientData,
static int PushVarName(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr,
int flags, int *localIndexPtr,
- int *simpleVarNamePtr, int *isScalarPtr, int line);
+ int *simpleVarNamePtr, int *isScalarPtr,
+ int line, int* clNext);
static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, const char *identity,
int instruction, CompileEnv *envPtr);
@@ -177,6 +183,11 @@ static void CompileReturnInternal(CompileEnv *envPtr,
unsigned char op, int code, int level,
Tcl_Obj *returnOpts);
+#define PushVarNameWord(i,v,e,f,l,s,sc,word) \
+ PushVarName (i,v,e,f,l,s,sc, \
+ mapPtr->loc [eclIndex].line [(word)], \
+ mapPtr->loc [eclIndex].next [(word)])
+
/*
* Flags bits used by PushVarName.
*/
@@ -266,9 +277,8 @@ TclCompileAppendCmd(
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, 0,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+ &localIndex, &simpleVarName, &isScalar, 1);
/*
* We are doing an assignment, otherwise TclCompileSetCmd was called, so
@@ -462,7 +472,7 @@ TclCompileCatchCmd(
* range so that errors in the substitution are not catched [Bug 219184]
*/
- envPtr->line = mapPtr->loc[eclIndex].line[1];
+ SetLineInformation (1);
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
ExceptionRangeStarts(envPtr, range);
CompileBody(envPtr, cmdTokenPtr, interp);
@@ -944,7 +954,7 @@ TclCompileDictForCmd(
* Compile the loop body itself. It should be stack-neutral.
*/
- envPtr->line = mapPtr->loc[eclIndex].line[4];
+ SetLineInformation (4);
CompileBody(envPtr, bodyTokenPtr, interp);
TclEmitOpcode( INST_POP, envPtr);
@@ -1481,7 +1491,7 @@ TclCompileForCmd(
* Inline compile the initial command.
*/
- envPtr->line = mapPtr->loc[eclIndex].line[1];
+ SetLineInformation (1);
CompileBody(envPtr, startTokenPtr, interp);
TclEmitOpcode(INST_POP, envPtr);
@@ -1504,7 +1514,7 @@ TclCompileForCmd(
*/
bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
- envPtr->line = mapPtr->loc[eclIndex].line[4];
+ SetLineInformation (4);
CompileBody(envPtr, bodyTokenPtr, interp);
ExceptionRangeEnds(envPtr, bodyRange);
envPtr->currStackDepth = savedStackDepth + 1;
@@ -1516,7 +1526,7 @@ TclCompileForCmd(
envPtr->currStackDepth = savedStackDepth;
nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
- envPtr->line = mapPtr->loc[eclIndex].line[3];
+ SetLineInformation (3);
CompileBody(envPtr, nextTokenPtr, interp);
ExceptionRangeEnds(envPtr, nextRange);
envPtr->currStackDepth = savedStackDepth + 1;
@@ -1537,7 +1547,7 @@ TclCompileForCmd(
testCodeOffset += 3;
}
- envPtr->line = mapPtr->loc[eclIndex].line[2];
+ SetLineInformation (2);
envPtr->currStackDepth = savedStackDepth;
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
@@ -1787,7 +1797,7 @@ TclCompileForeachCmd(
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
if ((i%2 == 0) && (i > 0)) {
- envPtr->line = mapPtr->loc[eclIndex].line[i];
+ SetLineInformation (i);
CompileTokens(envPtr, tokenPtr, interp);
tempVar = (firstValueTemp + loopIndex);
if (tempVar <= 255) {
@@ -1819,7 +1829,7 @@ TclCompileForeachCmd(
* Inline compile the loop body.
*/
- envPtr->line = mapPtr->loc[eclIndex].line[bodyIndex];
+ SetLineInformation (bodyIndex);
ExceptionRangeStarts(envPtr, range);
CompileBody(envPtr, bodyTokenPtr, interp);
ExceptionRangeEnds(envPtr, range);
@@ -2158,7 +2168,7 @@ TclCompileIfCmd(
compileScripts = 0;
}
} else {
- envPtr->line = mapPtr->loc[eclIndex].line[wordIdx];
+ SetLineInformation (wordIdx);
Tcl_ResetResult(interp);
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
@@ -2200,7 +2210,7 @@ TclCompileIfCmd(
*/
if (compileScripts) {
- envPtr->line = mapPtr->loc[eclIndex].line[wordIdx];
+ SetLineInformation (wordIdx);
envPtr->currStackDepth = savedStackDepth;
CompileBody(envPtr, tokenPtr, interp);
}
@@ -2288,7 +2298,7 @@ TclCompileIfCmd(
* Compile the else command body.
*/
- envPtr->line = mapPtr->loc[eclIndex].line[wordIdx];
+ SetLineInformation (wordIdx);
CompileBody(envPtr, tokenPtr, interp);
}
@@ -2390,9 +2400,8 @@ TclCompileIncrCmd(
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX,
+ &localIndex, &simpleVarName, &isScalar, 1);
/*
* If an increment is given, push it, but see first if it's a small
@@ -2418,7 +2427,7 @@ TclCompileIncrCmd(
PushLiteral(envPtr, word, numBytes);
}
} else {
- envPtr->line = mapPtr->loc[eclIndex].line[2];
+ SetLineInformation (2);
CompileTokens(envPtr, incrTokenPtr, interp);
}
} else { /* No incr amount given so use 1. */
@@ -2533,9 +2542,8 @@ TclCompileLappendCmd(
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, 0,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+ &localIndex, &simpleVarName, &isScalar, 1);
/*
* If we are doing an assignment, push the new value. In the no values
@@ -2640,8 +2648,8 @@ TclCompileLassignCmd(
* Generate the next variable name.
*/
- PushVarName(interp, tokenPtr, envPtr, 0, &localIndex,
- &simpleVarName, &isScalar, mapPtr->loc[eclIndex].line[idx+2]);
+ PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
+ &simpleVarName, &isScalar, idx+2);
/*
* Emit instructions to get the idx'th item out of the list value on
@@ -2977,9 +2985,8 @@ TclCompileLsetCmd(
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, 0,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+ &localIndex, &simpleVarName, &isScalar, 1);
/*
* Push the "index" args and the new element value.
@@ -3479,9 +3486,8 @@ TclCompileSetCmd(
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, 0,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+ &localIndex, &simpleVarName, &isScalar, 1);
/*
* If we are doing an assignment, push the new value.
@@ -3762,7 +3768,7 @@ TclCompileStringMatchCmd(
}
PushLiteral(envPtr, str, length);
} else {
- envPtr->line = mapPtr->loc[eclIndex].line[i+1+nocase];
+ SetLineInformation (i+1+nocase);
CompileTokens(envPtr, tokenPtr, interp);
}
tokenPtr = TokenAfter(tokenPtr);
@@ -3828,7 +3834,7 @@ TclCompileStringLenCmd(
len = sprintf(buf, "%d", len);
PushLiteral(envPtr, buf, len);
} else {
- envPtr->line = mapPtr->loc[eclIndex].line[1];
+ SetLineInformation (1);
CompileTokens(envPtr, tokenPtr, interp);
TclEmitOpcode(INST_STR_LEN, envPtr);
}
@@ -3878,6 +3884,7 @@ TclCompileSwitchCmd(
Tcl_Token **bodyToken; /* Array of pointers to pattern list items. */
int *bodyLines; /* Array of line numbers for body list
* items. */
+ int** bodyNext;
int foundDefault; /* Flag to indicate whether a "default" clause
* is present. */
@@ -3896,6 +3903,7 @@ TclCompileSwitchCmd(
int isListedArms = 0;
int i, valueIndex;
DefineLineInformation; /* TIP #280 */
+ int* clNext = envPtr->clNext;
/*
* Only handle the following versions:
@@ -4074,6 +4082,7 @@ TclCompileSwitchCmd(
bodyTokenArray = (Tcl_Token *) ckalloc(sizeof(Tcl_Token) * numWords);
bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
bodyLines = (int *) ckalloc(sizeof(int) * numWords);
+ bodyNext = (int **) ckalloc(sizeof(int*) * numWords);
/*
* Locate the start of the arms within the overall word.
@@ -4117,6 +4126,7 @@ TclCompileSwitchCmd(
ckfree((char *) bodyToken);
ckfree((char *) bodyTokenArray);
ckfree((char *) bodyLines);
+ ckfree((char *) bodyNext);
return TCL_ERROR;
}
@@ -4127,7 +4137,10 @@ TclCompileSwitchCmd(
*/
TclAdvanceLines(&bline, p, bodyTokenArray[i].start);
+ TclAdvanceContinuations (&bline, &clNext,
+ bodyTokenArray[i].start - envPtr->source);
bodyLines[i] = bline;
+ bodyNext[i] = clNext;
p = bodyTokenArray[i].start;
while (isspace(UCHAR(*tokenStartPtr))) {
@@ -4155,6 +4168,7 @@ TclCompileSwitchCmd(
ckfree((char *) bodyToken);
ckfree((char *) bodyTokenArray);
ckfree((char *) bodyLines);
+ ckfree((char *) bodyNext);
return TCL_ERROR;
}
@@ -4175,6 +4189,7 @@ TclCompileSwitchCmd(
bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
bodyLines = (int *) ckalloc(sizeof(int) * numWords);
+ bodyNext = (int **) ckalloc(sizeof(int*) * numWords);
bodyTokenArray = NULL;
for (i=0 ; i<numWords ; i++) {
/*
@@ -4187,6 +4202,7 @@ TclCompileSwitchCmd(
tokenPtr->numComponents != 1) {
ckfree((char *) bodyToken);
ckfree((char *) bodyLines);
+ ckfree((char *) bodyNext);
return TCL_ERROR;
}
bodyToken[i] = tokenPtr+1;
@@ -4196,6 +4212,7 @@ TclCompileSwitchCmd(
*/
bodyLines[i] = mapPtr->loc[eclIndex].line[valueIndex+1+i];
+ bodyNext[i] = mapPtr->loc[eclIndex].next[valueIndex+1+i];
tokenPtr = TokenAfter(tokenPtr);
}
}
@@ -4209,6 +4226,7 @@ TclCompileSwitchCmd(
bodyToken[numWords-1]->start[0] == '-') {
ckfree((char *) bodyToken);
ckfree((char *) bodyLines);
+ ckfree((char *) bodyNext);
if (bodyTokenArray != NULL) {
ckfree((char *) bodyTokenArray);
}
@@ -4220,7 +4238,7 @@ TclCompileSwitchCmd(
* First, we push the value we're matching against on the stack.
*/
- envPtr->line = mapPtr->loc[eclIndex].line[valueIndex];
+ SetLineInformation (valueIndex);
CompileTokens(envPtr, valueTokenPtr, interp);
/*
@@ -4342,6 +4360,7 @@ TclCompileSwitchCmd(
*/
envPtr->line = bodyLines[i+1]; /* TIP #280 */
+ envPtr->clNext = bodyNext[i+1]; /* TIP #280 */
TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
/*
@@ -4393,6 +4412,7 @@ TclCompileSwitchCmd(
ckfree((char *) finalFixups);
ckfree((char *) bodyToken);
ckfree((char *) bodyLines);
+ ckfree((char *) bodyNext);
if (bodyTokenArray != NULL) {
ckfree((char *) bodyTokenArray);
}
@@ -4554,6 +4574,7 @@ TclCompileSwitchCmd(
TclEmitOpcode(INST_POP, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
envPtr->line = bodyLines[i+1]; /* TIP #280 */
+ envPtr->clNext = bodyNext[i+1]; /* TIP #280 */
TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
if (!foundDefault) {
@@ -4570,6 +4591,7 @@ TclCompileSwitchCmd(
ckfree((char *) bodyToken);
ckfree((char *) bodyLines);
+ ckfree((char *) bodyNext);
if (bodyTokenArray != NULL) {
ckfree((char *) bodyTokenArray);
}
@@ -4826,7 +4848,7 @@ TclCompileWhileCmd(
* Compile the loop body.
*/
- envPtr->line = mapPtr->loc[eclIndex].line[2];
+ SetLineInformation (2);
bodyCodeOffset = ExceptionRangeStarts(envPtr, range);
CompileBody(envPtr, bodyTokenPtr, interp);
ExceptionRangeEnds(envPtr, range);
@@ -4846,7 +4868,7 @@ TclCompileWhileCmd(
testCodeOffset += 3;
}
envPtr->currStackDepth = savedStackDepth;
- envPtr->line = mapPtr->loc[eclIndex].line[1];
+ SetLineInformation (1);
TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
@@ -4911,7 +4933,8 @@ PushVarName(
int *localIndexPtr, /* Must not be NULL. */
int *simpleVarNamePtr, /* Must not be NULL. */
int *isScalarPtr, /* Must not be NULL. */
- int line) /* Line the token starts on. */
+ int line, /* Line the token starts on. */
+ int* clNext) /* Reference to offset of next hidden cont. line */
{
register const char *p;
const char *name, *elName;
@@ -5094,6 +5117,7 @@ PushVarName(
if (elName != NULL) {
if (elNameChars) {
envPtr->line = line;
+ envPtr->clNext = clNext;
TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr);
} else {
PushLiteral(envPtr, "", 0);
@@ -5105,6 +5129,7 @@ PushVarName(
*/
envPtr->line = line;
+ envPtr->clNext = clNext;
CompileTokens(envPtr, varTokenPtr, interp);
}
@@ -5881,9 +5906,8 @@ TclCompileUpvarCmd(
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, 1);
- PushVarName(interp, localTokenPtr, envPtr, 0,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, localTokenPtr, envPtr, 0,
+ &localIndex, &simpleVarName, &isScalar, 1);
if((localIndex < 0) || !isScalar) {
return TCL_ERROR;
@@ -5974,9 +5998,8 @@ TclCompileNamespaceCmd(
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, 1);
- PushVarName(interp, localTokenPtr, envPtr, 0,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, localTokenPtr, envPtr, 0,
+ &localIndex, &simpleVarName, &isScalar, 1);
if((localIndex < 0) || !isScalar) {
return TCL_ERROR;
@@ -6490,8 +6513,8 @@ TclCompileInfoExistsCmd(
*/
tokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, tokenPtr, envPtr, 0, &localIndex,
- &simpleVarName, &isScalar, mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
+ &simpleVarName, &isScalar, 1);
/*
* Emit instruction to check the variable for existence.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 6b8b7a5..a0ac9d3 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.c,v 1.170 2009/07/16 21:24:39 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.171 2009/08/25 21:03:25 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -431,7 +431,8 @@ static void PrintSourceToObj(Tcl_Obj *appendObj,
*/
static void EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset,
Tcl_Token *tokenPtr, const char *cmd, int len,
- int numWords, int line, int **lines);
+ int numWords, int line, int* clNext, int **lines,
+ CompileEnv* envPtr);
/*
* The structure below defines the bytecode Tcl object type by means of
@@ -487,6 +488,7 @@ TclSetByteCodeFromAny(
register int i;
int length, result = TCL_OK;
const char *stringPtr;
+ ContLineLoc* clLocPtr;
#ifdef TCL_COMPILE_DEBUG
if (!traceInitialized) {
@@ -508,6 +510,25 @@ TclSetByteCodeFromAny(
TclInitCompileEnv(interp, &compEnv, stringPtr, length,
iPtr->invokeCmdFramePtr, iPtr->invokeWord);
+ /*
+ * Now we check if we have data about invisible continuation lines for the
+ * script, and make it available to the compile environment, if so.
+ *
+ * It is not clear if the script Tcl_Obj* can be free'd while the compiler
+ * is using it, leading to the release of the associated ContLineLoc
+ * structure as well. To ensure that the latter doesn't happen we set a
+ * lock on it. We release this lock in the function TclFreeCompileEnv (),
+ * found in this file. The "lineCLPtr" hashtable is managed in the file
+ * "tclObj.c".
+ */
+
+ clLocPtr = TclContinuationsGet (objPtr);
+ if (clLocPtr) {
+ compEnv.clLoc = clLocPtr;
+ compEnv.clNext = &compEnv.clLoc->loc[0];
+ Tcl_Preserve (compEnv.clLoc);
+ }
+
TclCompileScript(interp, stringPtr, length, &compEnv);
/*
@@ -1015,6 +1036,15 @@ TclInitCompileEnv(
envPtr->extCmdMapPtr->start = envPtr->line;
+ /*
+ * Initialize the data about invisible continuation lines as empty,
+ * i.e. not used. The caller (TclSetByteCodeFromAny) will set this up, if
+ * such data is available.
+ */
+
+ envPtr->clLoc = NULL;
+ envPtr->clNext = NULL;
+
envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
envPtr->auxDataArrayNext = 0;
envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE;
@@ -1069,6 +1099,16 @@ TclFreeCompileEnv(
if (envPtr->extCmdMapPtr) {
ckfree((char *) envPtr->extCmdMapPtr);
}
+
+ /*
+ * If we used data about invisible continuation lines, then now is the
+ * time to release on our hold on it. The lock was set in function
+ * TclSetByteCodeFromAny(), found in this file.
+ */
+
+ if (envPtr->clLoc) {
+ Tcl_Release (envPtr->clLoc);
+ }
}
/*
@@ -1196,6 +1236,7 @@ TclCompileScript(
/* TIP #280 */
ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
int *wlines, wlineat, cmdLine;
+ int* clNext;
Tcl_Parse *parsePtr = (Tcl_Parse *)
TclStackAlloc(interp, sizeof(Tcl_Parse));
@@ -1221,6 +1262,7 @@ TclCompileScript(
p = script;
bytesLeft = numBytes;
cmdLine = envPtr->line;
+ clNext = envPtr->clNext;
do {
if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
/*
@@ -1320,10 +1362,12 @@ TclCompileScript(
*/
TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
+ TclAdvanceContinuations (&cmdLine, &clNext,
+ parsePtr->commandStart - envPtr->source);
EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
parsePtr->tokenPtr, parsePtr->commandStart,
parsePtr->commandSize, parsePtr->numWords, cmdLine,
- &wlines);
+ clNext, &wlines, envPtr);
wlineat = eclPtr->nuloc - 1;
/*
@@ -1336,6 +1380,7 @@ TclCompileScript(
tokenPtr += (tokenPtr->numComponents + 1)) {
envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
+ envPtr->clNext = eclPtr->loc [wlineat].next [wordIdx];
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
/*
* The word is not a simple string of characters.
@@ -1498,6 +1543,12 @@ TclCompileScript(
*/
objIndex = TclRegisterNewLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size);
+
+ if (envPtr->clNext) {
+ TclContinuationsEnterDerived (envPtr->literalArrayPtr[objIndex].objPtr,
+ tokenPtr[1].start - envPtr->source,
+ eclPtr->loc [wlineat].next [wordIdx]);
+ }
}
TclEmitPush(objIndex, envPtr);
} /* for loop */
@@ -1559,7 +1610,9 @@ TclCompileScript(
*/
ckfree((char *) eclPtr->loc[wlineat].line);
+ ckfree((char *) eclPtr->loc[wlineat].next);
eclPtr->loc[wlineat].line = wlines;
+ eclPtr->loc[wlineat].next = NULL;
} /* end if parsePtr->numWords > 0 */
/*
@@ -1575,6 +1628,7 @@ TclCompileScript(
*/
TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
+ TclAdvanceContinuations (&cmdLine, &clNext, p - envPtr->source);
Tcl_FreeParse(parsePtr);
} while (bytesLeft > 0);
@@ -1635,6 +1689,41 @@ TclCompileTokens(
int numObjsToConcat, nameBytes, localVarName, localVar;
int length, i;
unsigned char *entryCodeNext = envPtr->codeNext;
+#define NUM_STATIC_POS 20
+ int isLiteral, maxNumCL, numCL;
+ int* clPosition;
+
+ /*
+ * 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.
+ *
+ * Note: Different to the equivalent code in function 'TclSubstTokens()'
+ * (see file "tclParse.c") we do not seem to need the 'adjust'
+ * variable. We also do not seem to need code which merges continuation
+ * line information of multiple words which concat'd at runtime. Either
+ * that or I have not managed to find a test case for these two
+ * possibilities yet. It might be a difference between compile- versus
+ * runtime processing.
+ */
+
+ 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));
+ }
Tcl_DStringInit(&textBuffer);
numObjsToConcat = 0;
@@ -1647,6 +1736,36 @@ TclCompileTokens(
case TCL_TOKEN_BS:
length = Tcl_UtfBackslash(tokenPtr->start, NULL, buffer);
Tcl_DStringAppend(&textBuffer, buffer, length);
+
+ /*
+ * 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 ((length == 1) && (buffer[0] == ' ') &&
+ (tokenPtr->start[1] == '\n')) {
+ if (isLiteral) {
+ int clPos = Tcl_DStringLength (&textBuffer);
+
+ if (numCL >= maxNumCL) {
+ maxNumCL *= 2;
+ clPosition = (int*) ckrealloc ((char*)clPosition,
+ maxNumCL*sizeof(int));
+ }
+ clPosition[numCL] = clPos;
+ numCL ++;
+ }
+ }
break;
case TCL_TOKEN_COMMAND:
@@ -1662,6 +1781,12 @@ TclCompileTokens(
TclEmitPush(literal, envPtr);
numObjsToConcat++;
Tcl_DStringFree(&textBuffer);
+
+ if (numCL) {
+ TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
+ numCL, clPosition);
+ }
+ numCL = 0;
}
TclCompileScript(interp, tokenPtr->start+1,
@@ -1770,6 +1895,12 @@ TclCompileTokens(
Tcl_DStringLength(&textBuffer));
TclEmitPush(literal, envPtr);
numObjsToConcat++;
+
+ if (numCL) {
+ TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
+ numCL, clPosition);
+ }
+ numCL = 0;
}
/*
@@ -1792,6 +1923,15 @@ TclCompileTokens(
TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
}
Tcl_DStringFree(&textBuffer);
+
+ /*
+ * Release the temp table we used to collect the locations of
+ * continuation lines, if any.
+ */
+
+ if (maxNumCL) {
+ ckfree ((char*) clPosition);
+ }
}
/*
@@ -2461,11 +2601,14 @@ EnterCmdWordData(
int len,
int numWords,
int line,
- int **wlines)
+ int* clNext,
+ int **wlines,
+ CompileEnv* envPtr)
{
ECL *ePtr;
const char *last;
int wordIdx, wordLine, *wwlines;
+ int* wordNext;
if (eclPtr->nuloc >= eclPtr->nloc) {
/*
@@ -2485,17 +2628,22 @@ EnterCmdWordData(
ePtr = &eclPtr->loc[eclPtr->nuloc];
ePtr->srcOffset = srcOffset;
ePtr->line = (int *) ckalloc(numWords * sizeof(int));
+ ePtr->next = (int**) ckalloc (numWords * sizeof (int*));
ePtr->nline = numWords;
wwlines = (int *) ckalloc(numWords * sizeof(int));
last = cmd;
wordLine = line;
+ wordNext = clNext;
for (wordIdx=0 ; wordIdx<numWords;
wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
TclAdvanceLines(&wordLine, last, tokenPtr->start);
+ TclAdvanceContinuations (&wordLine, &wordNext,
+ tokenPtr->start - envPtr->source);
wwlines[wordIdx] =
(TclWordKnownAtCompileTime(tokenPtr, NULL) ? wordLine : -1);
ePtr->line[wordIdx] = wordLine;
+ ePtr->next[wordIdx] = wordNext;
last = tokenPtr->start;
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 75dc236..4d9dbd1 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.h,v 1.117 2009/07/14 16:34:08 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.118 2009/08/25 21:03:25 andreas_kupries Exp $
*/
#ifndef _TCLCOMPILATION
@@ -132,6 +132,9 @@ typedef struct ECL {
int nline; /* Number of words in the command */
int *line; /* Line information for all words in the
* command. */
+ int** next; /* Transient information used by the compiler
+ * for tracking of hidden continuation
+ * lines. */
} ECL;
typedef struct ExtCmdLoc {
@@ -309,6 +312,13 @@ typedef struct CompileEnv {
* should be issued; they should never be
* issued repeatedly, as that is significantly
* inefficient. */
+ ContLineLoc* clLoc; /* If not NULL, the table holding the
+ * locations of the invisible continuation
+ * lines in the input script, to adjust the
+ * line counter. */
+ int* clNext; /* If not NULL, it refers to the next slot in
+ * clLoc to check for an invisible
+ * continuation line. */
} CompileEnv;
/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3501083..6443c6f 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.436 2009/08/24 03:18:23 das Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.437 2009/08/25 21:03:25 andreas_kupries Exp $
*/
#ifndef _TCLINT
@@ -1196,6 +1196,36 @@ typedef struct CFWordBC {
} CFWordBC;
/*
+ * Structure to record the locations of invisible continuation lines in
+ * literal scripts, as character offset from the beginning of the script. Both
+ * compiler and direct evaluator use this information to adjust their line
+ * counters when tracking through the script, because when it is invoked the
+ * continuation line marker as a whole has been removed already, meaning that
+ * the \n which was part of it is gone as well, breaking regular line
+ * tracking.
+ *
+ * These structures are allocated and filled by both the function
+ * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the
+ * file "tclBasic.c", and stored in the thread-global hashtable "lineCLPtr" in
+ * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and
+ * TclCompileScript(), both found in the file "tclCompile.c". Their memory is
+ * released by the function TclFreeObj(), in the file "tclObj.c", and also by
+ * the function TclThreadFinalizeObjects(), in the same file.
+ */
+
+#define CLL_END (-1)
+
+typedef struct ContLineLoc {
+ int num; /* Number of entries in loc, not counting the final -1
+ * marker entry */
+ int loc[1]; /* Table of locations, as character offsets. The table
+ * is allocated as part of the structure, i.e. the loc
+ * array extends behind the nominal end of the
+ * structure. An entry containing the value -1 is put
+ * after the last location, as end-marker/sentinel. */
+} ContLineLoc;
+
+/*
* The following macros define the allowed values for the type field of the
* CmdFrame structure above. Some of the values occur only in the extended
* location data referenced via the 'baseLocPtr'.
@@ -1983,6 +2013,16 @@ typedef struct Interp {
* invoking command. Alt view: An index to the
* CmdFrame stack keyed by command argument
* holders. */
+ ContLineLoc* scriptCLLocPtr;
+ /* This table points to the location data for
+ * invisible continuation lines in the script,
+ * if any. This pointer is set by the function
+ * TclEvalObjEx() in file "tclBasic.c", and
+ * used by function ...() in the same file.
+ * It does for the eval/direct path of script
+ * execution what CompileEnv.clLoc does for
+ * the bytecode compiler.
+ */
/*
* TIP #268. The currently active selection mode, i.e. the package require
* preferences.
@@ -2651,6 +2691,7 @@ typedef struct ForIterData {
MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags);
MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
+MODULE_SCOPE void TclAdvanceContinuations(int* line, int** next, int loc);
MODULE_SCOPE void TclAdvanceLines(int *line, const char *start,
const char *end);
MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp,
@@ -2678,11 +2719,16 @@ MODULE_SCOPE int TclClearRootEnsemble(ClientData data[],
Tcl_Interp *interp, int result);
MODULE_SCOPE void TclCleanupLiteralTable(Tcl_Interp *interp,
LiteralTable *tablePtr);
+MODULE_SCOPE ContLineLoc* TclContinuationsEnter(Tcl_Obj* objPtr, int num, int* loc);
+MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext);
+MODULE_SCOPE ContLineLoc* TclContinuationsGet(Tcl_Obj* objPtr);
+MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr);
MODULE_SCOPE int TclDoubleDigits(char *buf, double value, int *signum);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
/* TIP #280 - Modified token based evulation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
- int numBytes, int flags, int line);
+ int numBytes, int flags, int line,
+ int* clNextOuter, CONST char* outerScript);
MODULE_SCOPE int TclFileAttrsCmd(Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int TclFileCopyCmd(Tcl_Interp *interp,
@@ -2776,8 +2822,8 @@ MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp,
MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
int indexCount, Tcl_Obj *const indexArray[]);
/* TIP #280 */
-MODULE_SCOPE void TclListLines(const char *listStr, int line, int n,
- int *lines);
+MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n,
+ int *lines, Tcl_Obj* const* elems);
MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
MODULE_SCOPE int TclLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
int symc, const char *symbols[],
@@ -2903,7 +2949,8 @@ MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj * TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
- int count, int *tokensLeftPtr, int line);
+ int count, int *tokensLeftPtr, int line,
+ int* clNextOuter, CONST char* outerScript);
MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE Tcl_PackageInitProc *TclpFindSymbol(Tcl_Interp *interp,
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 8052028..0bdb371 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.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: tclObj.c,v 1.155 2009/08/12 16:06:44 dgp Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.156 2009/08/25 21:03:25 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -68,18 +68,45 @@ typedef struct ObjData {
int line; /* Line number in the source file; used for
* debugging. */
} ObjData;
-
+#endif /* TCL_MEM_DEBUG && TCL_THREADS */
+
/*
- * Thread local table that is used to check that a Tcl_Obj was not allocated
- * by some other thread.
+ * All static variables used in this file are collected into a single instance
+ * of the following structure. For multi-threaded implementations, there is
+ * one instance of this structure for each thread.
+ *
+ * Notice that different structures with the same name appear in other files.
+ * The structure defined below is used in this file only.
*/
typedef struct ThreadSpecificData {
+ Tcl_HashTable* lineCLPtr; /* This table remembers for each Tcl_Obj
+ * generated by a call to the function
+ * EvalTokensStandard() from a literal text
+ * where bs+nl sequences occured in it, if
+ * any. I.e. this table keeps track of
+ * invisible/stripped continuation lines. Its
+ * keys are Tcl_Obj pointers, the values are
+ * ContLineLoc pointers. See the file
+ * tclCompile.h for the definition of this
+ * structure, and for references to all related
+ * places in the core.
+ */
+#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+ /*
+ * Thread local table that is used to check that a Tcl_Obj was not
+ * allocated by some other thread.
+ */
+
Tcl_HashTable *objThreadMap;
+#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
-#endif /* TCL_MEM_DEBUG && TCL_THREADS */
+
+static void ContLineLocFree (char* clientData);
+static void TclThreadFinalizeObjects (ClientData clientData);
+static ThreadSpecificData* TclGetTables (void);
/*
* Nested Tcl_Obj deletion management support
@@ -428,7 +455,7 @@ TclFinalizeThreadObjects(void)
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr = TclGetTables();
Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
if (tablePtr != NULL) {
@@ -486,6 +513,313 @@ TclFinalizeObjects(void)
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetTables --
+ *
+ * This procedure is a helper which returns the thread-specific
+ * hash-table used to track continuation line information associated with
+ * Tcl_Obj*, and the objThreadMap, etc.
+ *
+ * Results:
+ * A reference to the thread-data.
+ *
+ * Side effects:
+ * May allocate memory for the thread-data.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+static ThreadSpecificData*
+TclGetTables()
+{
+ /*
+ * Initialize the hashtable tracking invisible continuation lines. For
+ * the release we use a thread exit handler to ensure that this is done
+ * before TSD blocks are made invalid. The TclFinalizeObjects() which
+ * would be the natural place for this is invoked afterwards, meaning that
+ * we try to operate on a data structure already gone.
+ */
+
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ if (!tsdPtr->lineCLPtr) {
+ tsdPtr->lineCLPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
+ Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
+ Tcl_CreateThreadExitHandler (TclThreadFinalizeObjects,NULL);
+#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+ tsdPtr->objThreadMap = NULL;
+#endif /* TCL_MEM_DEBUG && TCL_THREADS */
+ }
+ return tsdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclContinuationsEnter --
+ *
+ * This procedure is a helper which saves the continuation line
+ * information associated with a Tcl_Obj*.
+ *
+ * Results:
+ * A reference to the newly created continuation line location table.
+ *
+ * Side effects:
+ * Allocates memory for the table of continuation line locations.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+ContLineLoc*
+TclContinuationsEnter(Tcl_Obj* objPtr,
+ int num,
+ int* loc)
+{
+ int newEntry;
+ ThreadSpecificData *tsdPtr = TclGetTables();
+ Tcl_HashEntry* hPtr =
+ Tcl_CreateHashEntry (tsdPtr->lineCLPtr, (char*) objPtr, &newEntry);
+
+ ContLineLoc* clLocPtr =
+ (ContLineLoc*) ckalloc (sizeof(ContLineLoc) + num*sizeof(int));
+
+ clLocPtr->num = num;
+ memcpy (&clLocPtr->loc, loc, num*sizeof(int));
+ clLocPtr->loc[num] = CLL_END; /* Sentinel */
+ Tcl_SetHashValue (hPtr, clLocPtr);
+
+ return clLocPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclContinuationsEnterDerived --
+ *
+ * This procedure is a helper which computes the continuation line
+ * information associated with a Tcl_Obj* cut from the middle of a
+ * script.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates memory for the table of continuation line locations.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
+{
+ /*
+ * We have to handle invisible continuations lines here as well, despite
+ * the code we have in TclSubstTokens (TST) for that. Why ? Nesting. If
+ * our script is the sole argument to an 'eval' command, for example, the
+ * scriptCLLocPtr we are using was generated by a previous call to TST,
+ * and while the words we have here may contain continuation lines they
+ * are invisible already, and the inner call to TST had no bs+nl sequences
+ * to trigger its code.
+ *
+ * Luckily for us, the table we have to create here for the current word
+ * has to be a slice of the table currently in use, with the locations
+ * suitably modified to be relative to the start of the word instead of
+ * relative to the script.
+ *
+ * That is what we are doing now. Determine the slice we need, and if not
+ * empty, wrap it into a new table, and save the result into our
+ * thread-global hashtable, as usual.
+ */
+
+ /*
+ * First compute the range of the word within the script.
+ */
+
+ int length, end, num;
+ int* wordCLLast = clNext;
+
+ Tcl_GetStringFromObj(objPtr, &length);
+ /* Is there a better way which doesn't shimmer ? */
+
+ end = start + length; /* first char after the word */
+
+ /*
+ * Then compute the table slice covering the range of
+ * the word.
+ */
+
+ while (*wordCLLast >= 0 && *wordCLLast < end) {
+ wordCLLast++;
+ }
+
+ /*
+ * And generate the table from the slice, if it was
+ * not empty.
+ */
+
+ num = wordCLLast - clNext;
+ if (num) {
+ int i;
+ ContLineLoc* clLocPtr =
+ TclContinuationsEnter(objPtr, num, clNext);
+
+ /*
+ * Re-base the locations.
+ */
+
+ for (i=0;i<num;i++) {
+ clLocPtr->loc[i] -= start;
+
+ /*
+ * Continuation lines coming before the string and affecting us
+ * should not happen, due to the proper maintenance of clNext
+ * during compilation.
+ */
+
+ if (clLocPtr->loc[i] < 0) {
+ Tcl_Panic("Derived ICL data for object using offsets from before the script");
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclContinuationsCopy --
+ *
+ * This procedure is a helper which copies the continuation line
+ * information associated with a Tcl_Obj* to another Tcl_Obj*.
+ * It is assumed that both contain the same string/script. Use
+ * this when a script is duplicated because it was shared.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates memory for the table of continuation line locations.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr)
+{
+ ThreadSpecificData *tsdPtr = TclGetTables();
+ Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) originObjPtr);
+
+ if (hPtr) {
+ ContLineLoc* clLocPtr = (ContLineLoc*) Tcl_GetHashValue (hPtr);
+
+ TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclContinuationsGet --
+ *
+ * This procedure is a helper which retrieves the continuation line
+ * information associated with a Tcl_Obj*, if it has any.
+ *
+ * Results:
+ * A reference to the continuation line location table, or NULL
+ * if the Tcl_Obj* has no such information associated with it.
+ *
+ * Side effects:
+ * None.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+ContLineLoc*
+TclContinuationsGet(Tcl_Obj* objPtr)
+{
+ ThreadSpecificData *tsdPtr = TclGetTables();
+ Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) objPtr);
+
+ if (hPtr) {
+ return (ContLineLoc*) Tcl_GetHashValue (hPtr);
+ } else {
+ return NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclThreadFinalizeObjects --
+ *
+ * This procedure is a helper which releases all continuation line
+ * information currently known. It is run as a thread exit handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Releases memory.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+static void
+TclThreadFinalizeObjects (ClientData clientData)
+{
+ /*
+ * Release the hashtable tracking invisible continuation lines.
+ */
+
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch hSearch;
+ ThreadSpecificData *tsdPtr = TclGetTables();
+
+ for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
+ hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&hSearch)) {
+ /*
+ * We are not using Tcl_EventuallyFree (as in TclFreeObj()) because
+ * here we can be sure that the compiler will not hold references to
+ * the data in the hashtable, and using TEF might bork the
+ * finalization sequence.
+ */
+ ContLineLocFree (Tcl_GetHashValue (hPtr));
+ Tcl_DeleteHashEntry (hPtr);
+ }
+ Tcl_DeleteHashTable (tsdPtr->lineCLPtr);
+ tsdPtr->lineCLPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ContLineLocFree --
+ *
+ * The freProc for continuation line location tables.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Releases memory.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+static void
+ContLineLocFree (char* clientData)
+{
+ ckfree (clientData);
+}
+
+/*
*--------------------------------------------------------------
*
* Tcl_RegisterObjType --
@@ -677,7 +1011,7 @@ TclDbDumpActiveObjects(
Tcl_HashSearch hSearch;
Tcl_HashEntry *hPtr;
Tcl_HashTable *tablePtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr = TclGetTables();
tablePtr = tsdPtr->objThreadMap;
@@ -744,7 +1078,7 @@ TclDbInitNewObj(
Tcl_HashTable *tablePtr;
int isNew;
ObjData *objData;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr = TclGetTables();
if (tsdPtr->objThreadMap == NULL) {
tsdPtr->objThreadMap = (Tcl_HashTable *)
@@ -1010,6 +1344,28 @@ TclFreeObj(
}
ObjDeletionUnlock(context);
}
+
+ /*
+ * We cannot use TclGetContinuationTable() here, because that may
+ * re-initialize the thread-data for calls coming after the
+ * finalization. We have to access it using the low-level call and then
+ * check for validity. This function can be called after
+ * TclFinalizeThreadData() has already killed the thread-global data
+ * structures. Performing TCL_TSD_INIT will leave us with an
+ * un-initialized memory block upon which we crash (if we where to access
+ * the uninitialized hashtable).
+ */
+
+ {
+ ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey);
+ if (tsdPtr->lineCLPtr) {
+ Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char *) objPtr);
+ if (hPtr) {
+ Tcl_EventuallyFree (Tcl_GetHashValue (hPtr), ContLineLocFree);
+ Tcl_DeleteHashEntry (hPtr);
+ }
+ }
+ }
}
#else /* TCL_MEM_DEBUG */
@@ -1075,6 +1431,28 @@ TclFreeObj(
ObjDeletionUnlock(context);
}
}
+
+ /*
+ * We cannot use TclGetContinuationTable() here, because that may
+ * re-initialize the thread-data for calls coming after the
+ * finalization. We have to access it using the low-level call and then
+ * check for validity. This function can be called after
+ * TclFinalizeThreadData() has already killed the thread-global data
+ * structures. Performing TCL_TSD_INIT will leave us with an
+ * un-initialized memory block upon which we crash (if we where to access
+ * the uninitialized hashtable).
+ */
+
+ {
+ ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey);
+ if (tsdPtr->lineCLPtr) {
+ Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char *) objPtr);
+ if (hPtr) {
+ Tcl_EventuallyFree (Tcl_GetHashValue (hPtr), ContLineLocFree);
+ Tcl_DeleteHashEntry (hPtr);
+ }
+ }
+ }
}
#endif
@@ -3267,7 +3645,7 @@ Tcl_DbIncrRefCount(
if (!TclInExit()) {
Tcl_HashTable *tablePtr;
Tcl_HashEntry *hPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr = TclGetTables();
tablePtr = tsdPtr->objThreadMap;
if (!tablePtr) {
@@ -3332,7 +3710,7 @@ Tcl_DbDecrRefCount(
if (!TclInExit()) {
Tcl_HashTable *tablePtr;
Tcl_HashEntry *hPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr = TclGetTables();
tablePtr = tsdPtr->objThreadMap;
if (!tablePtr) {
@@ -3412,7 +3790,7 @@ Tcl_DbIsShared(
if (!TclInExit()) {
Tcl_HashTable *tablePtr;
Tcl_HashEntry *hPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr = TclGetTables();
tablePtr = tsdPtr->objThreadMap;
if (!tablePtr) {
Tcl_Panic("object table not initialized");
diff --git a/generic/tclParse.c b/generic/tclParse.c
index db64728..69cc830 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -1553,7 +1553,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;
@@ -2062,7 +2062,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);
@@ -2107,7 +2107,7 @@ Tcl_SubstObj(
}
code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
- &tokensLeft, 1);
+ &tokensLeft, 1, NULL, NULL);
}
}
@@ -2145,10 +2145,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
@@ -2160,6 +2181,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;
@@ -2177,17 +2223,66 @@ 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: {
- Interp *iPtr = (Interp *) interp;
-
/* TIP #280: Transfer line information to nested command */
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;
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--;
TclResetCancellation(interp, 0);
@@ -2205,7 +2300,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 +2384,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);
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 98784c3..12e19da 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.173 2009/07/16 21:24:40 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.174 2009/08/25 21:03:25 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -440,8 +440,18 @@ TclCreateProc(
*/
if (Tcl_IsShared(bodyPtr)) {
+ Tcl_Obj* sharedBodyPtr = bodyPtr;
+
bytes = TclGetStringFromObj(bodyPtr, &length);
bodyPtr = Tcl_NewStringObj(bytes, length);
+
+ /*
+ * TIP #280.
+ * Ensure that the continuation line data for the original body is
+ * not lost and applies to the new body as well.
+ */
+
+ TclContinuationsCopy (bodyPtr, sharedBodyPtr);
}
/*
@@ -2538,7 +2548,7 @@ SetLambdaFromAny(
* location (line of 2nd list element).
*/
- TclListLines(name, contextPtr->line[1], 2, buf);
+ TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 52eaf9f..ebd9d96 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclVar.c,v 1.181 2009/07/23 23:01:59 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.182 2009/08/25 21:03:25 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -1876,6 +1876,9 @@ TclPtrSetVar(
} else {
if (Tcl_IsShared(oldValuePtr)) { /* Append to copy. */
varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+
+ TclContinuationsCopy (varPtr->value.objPtr, oldValuePtr);
+
TclDecrRefCount(oldValuePtr);
oldValuePtr = varPtr->value.objPtr;
Tcl_IncrRefCount(oldValuePtr); /* Since var is ref */
diff --git a/tests/info.test b/tests/info.test
index 53a0e76..65d71bc 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -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: info.test,v 1.64 2009/07/14 16:34:09 andreas_kupries Exp $
+# RCS: @(#) $Id: info.test,v 1.65 2009/08/25 21:03:25 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -767,7 +767,7 @@ test info-22.8 {info frame, basic trace} -match glob -body {
* {type source line 765 file info.test cmd etrace proc ::tcltest::RunTest}
* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}
-## The line 1967 is off by 5 from the true value of 1972. This is a knownBug, see testcase 30.0
+
test info-23.0.0 {eval'd info frame} {!singleTestInterp} {
eval {info frame}
} 8
@@ -806,7 +806,7 @@ test info-23.6 {eval'd info frame, trace} -match glob -body {
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
* {type source line 805 file info.test cmd {eval $script} proc ::tcltest::RunTest}}
-## The line 1967 is off by 5 from the true value of 1972. This is a knownBug, see testcase 30.0
+
# -------------------------------------------------------------------------
# Procedures defined in scripts which are arguments to control
@@ -1011,20 +1011,20 @@ test info-25.1 {info frame, regular proc} {
rename bar {}
# -------------------------------------------------------------------------
-
-test info-30.0 {bs+nl in literal words} knownBug {
+# More info-30.x test cases at the end of the file.
+test info-30.0 {bs+nl in literal words} {
if {1} {
set res \
- [reduce [info frame 0]]
+ [reduce [info frame 0]];#1018
}
set res
- # This is reporting line 3 instead of the correct 4 because the
+ # This was reporting line 3 instead of the correct 4 because the
# bs+nl combination is subst by the parser before the 'if'
- # command, and the the bcc sees the word. To fix record the
- # offsets of all bs+nl sequences in literal words, then use the
- # information in the bcc to bump line numbers when parsing over
- # the location. Also affected: testcases 22.8 and 23.6.
-} {type eval line 4 cmd {info frame 0} proc ::tcltest::RunTest}
+ # command, and the bcc, see the word. Fixed by recording the
+ # offsets of all bs+nl sequences in literal words, then using the
+ # information in the bcc and other places to bump line numbers when
+ # parsing over the location. Also affected: testcases 22.8 and 23.6.
+} {type source line 1018 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
# -------------------------------------------------------------------------
# See 24.0 - 24.5 for similar situations, using literal scripts.
@@ -1436,6 +1436,279 @@ type source line 1427 file info.test cmd {info frame 0} proc ::foo::bar level 0
type source line 1428 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
+# Additional tests for info-30.*, handling of continuation lines (bs+nl sequences).
+
+test info-30.1 {bs+nl in literal words, procedure body, compiled} {
+ proc abra {} {
+ if {1} \
+ {
+ return \
+ [reduce [info frame 0]];# line 1446
+ }
+ }
+ set res [abra]
+ rename abra {}
+ set res
+} {type source line 1446 file info.test cmd {info frame 0} proc ::abra level 0}
+
+test info-30.2 {bs+nl in literal words, namespace script} {
+ namespace eval xxx {
+ set res \
+ [reduce [info frame 0]];# line 1457
+ }
+ set res
+} {type source line 1457 file info.test cmd {info frame 0} level 0}
+
+test info-30.3 {bs+nl in literal words, namespace multi-word script} {
+ namespace eval xxx set res \
+ [list [reduce [info frame 0]]];# line 1464
+ set res
+} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.4 {bs+nl in literal words, eval script} {
+ eval {
+ set ::res \
+ [reduce [info frame 0]];# line 1471
+ }
+ set res
+} {type source line 1471 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.5 {bs+nl in literal words, eval script, with nested words} {
+ eval {
+ if {1} \
+ {
+ set ::res \
+ [reduce [info frame 0]];# line 1481
+ }
+ }
+ set res
+} {type source line 1481 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.6 {bs+nl in computed word} {
+ set res "\
+[reduce [info frame 0]]";# line 1489
+} { type source line 1489 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.7 {bs+nl in computed word, in proc} {
+ proc abra {} {
+ return "\
+[reduce [info frame 0]]";# line 1495
+ }
+ set res [abra]
+ rename abra {}
+ set res
+} { type source line 1495 file info.test cmd {info frame 0} proc ::abra level 0}
+
+test info-30.8 {bs+nl in computed word, nested eval} {
+ eval {
+ set \
+ res "\
+[reduce [info frame 0]]";# line 1506
+}
+} { type source line 1506 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.9 {bs+nl in computed word, nested eval} {
+ eval {
+ set \
+ res "\
+[reduce \
+ [info frame 0]]";# line 1515
+}
+} { type source line 1515 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.10 {bs+nl in computed word, key to array} {
+ set tmp([set \
+ res "\
+[reduce \
+ [info frame 0]]"]) x ; #1523
+ unset tmp
+ set res
+} { type source line 1523 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.11 {bs+nl in subst arguments, no true counting} {
+ subst {[set \
+ res "\
+[reduce \
+ [info frame 0]]"]}
+} { type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.12 {bs+nl in computed word, nested eval} {
+ eval {
+ set \
+ res "\
+[set x {}] \
+[reduce \
+ [info frame 0]]";# line 1541
+}
+} { type source line 1541 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.13 {bs+nl in literal words, uplevel script, with nested words} {
+ uplevel #0 {
+ if {1} \
+ {
+ set ::res \
+ [reduce [info frame 0]];# line 1550
+ }
+ }
+ set res
+} {type source line 1550 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.14 {bs+nl, literal word, uplevel through proc} {
+ proc abra {script} {
+ uplevel 1 $script
+ }
+ set res [abra {
+ return "\
+[reduce [info frame 0]]";# line 1562
+ }]
+ rename abra {}
+ set res
+} { type source line 1562 file info.test cmd {info frame 0} proc ::abra}
+
+test info-30.15 {bs+nl in literal words, nested proc body, compiled} {
+ proc a {} {
+ proc b {} {
+ if {1} \
+ {
+ return \
+ [reduce [info frame 0]];# line 1574
+ }
+ }
+ }
+ a ; set res [b]
+ rename a {}
+ rename b {}
+ set res
+} {type source line 1574 file info.test cmd {info frame 0} proc ::b level 0}
+
+test info-30.16 {bs+nl in multi-body switch, compiled} {
+ proc a {value} {
+ switch -regexp -- $value \
+ ^key { info frame 0; # 1587 } \
+ \t### { info frame 0; # 1588 } \
+ {[0-9]*} { info frame 0; # 1589 }
+ }
+ set res {}
+ lappend res [reduce [a {key }]]
+ lappend res [reduce [a {1alpha}]]
+ set res "\n[join $res \n]"
+} {
+type source line 1587 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1589 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.17 {bs+nl in multi-body switch, direct} {
+ switch -regexp -- {key } \
+ ^key { reduce [info frame 0] ;# 1601 } \
+ \t### { } \
+ {[0-9]*} { }
+} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.18 {bs+nl, literal word, uplevel through proc, appended, loss of primary tracking data} {
+ proc abra {script} {
+ append script "\n# end of script"
+ uplevel 1 $script
+ }
+ set res [abra {
+ return "\
+[reduce [info frame 0]]";# line 1613, still line of 3 appended script
+ }]
+ rename abra {}
+ set res
+} { type eval line 3 cmd {info frame 0} proc ::abra}
+# { type source line 1606 file info.test cmd {info frame 0} proc ::abra}
+
+test info-30.19 {bs+nl in single-body switch, compiled} {
+ proc a {value} {
+ switch -regexp -- $value {
+ ^key { reduce \
+ [info frame 0] }
+ \t { reduce \
+ [info frame 0] }
+ {[0-9]*} { reduce \
+ [info frame 0] }
+ }
+ }
+ set res {}
+ lappend res [a {key }]
+ lappend res [a {1alpha}]
+ set res "\n[join $res \n]"
+} {
+type source line 1624 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1628 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.20 {bs+nl in single-body switch, direct} {
+ switch -regexp -- {key } { \
+
+ ^key { reduce \
+ [info frame 0] }
+ \t### { }
+ {[0-9]*} { }
+ }
+} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.21 {bs+nl in if, full compiled} {
+ proc a {value} {
+ if {$value} \
+ {info frame 0} \
+ {info frame 0} ; # 1653
+ }
+ set res {}
+ lappend res [reduce [a 1]]
+ lappend res [reduce [a 0]]
+ set res "\n[join $res \n]"
+} {
+type source line 1652 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1653 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.22 {bs+nl in computed word, key to array, compiled} {
+ proc a {} {
+ set tmp([set \
+ res "\
+[reduce \
+ [info frame 0]]"]) x ; #1668
+ unset tmp
+ set res
+ }
+ set res [a]
+ rename a {}
+ set res
+} { type source line 1668 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.23 {bs+nl in multi-body switch, full compiled} {
+ proc a {value} {
+ switch -exact -- $value \
+ key { info frame 0; # 1680 } \
+ xxx { info frame 0; # 1681 } \
+ 000 { info frame 0; # 1682 }
+ }
+ set res {}
+ lappend res [reduce [a key]]
+ lappend res [reduce [a 000]]
+ set res "\n[join $res \n]"
+} {
+type source line 1680 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1682 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.24 {bs+nl in single-body switch, full compiled} {
+ proc a {value} {
+ switch -exact -- $value {
+ key { reduce \
+ [info frame 0] }
+ xxx { reduce \
+ [info frame 0] }
+ 000 { reduce \
+ [info frame 0] }
+ }
+ }
+ set res {}
+ lappend res [a key]
+ lappend res [a 000]
+ set res "\n[join $res \n]"
+} {
+type source line 1696 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1700 file info.test cmd {info frame 0} proc ::a level 0}
+
+# -------------------------------------------------------------------------
# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
generated by cgit v0.12 at 2024-11-08 04:18:35 (GMT)