summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog25
-rw-r--r--generic/tclBasic.c162
-rw-r--r--generic/tclCmdMZ.c26
-rw-r--r--generic/tclCompCmds.c115
-rw-r--r--generic/tclCompile.c163
-rw-r--r--generic/tclCompile.h12
-rw-r--r--generic/tclInt.h57
-rw-r--r--generic/tclObj.c390
-rw-r--r--generic/tclParse.c130
-rw-r--r--generic/tclProc.c14
-rw-r--r--generic/tclVar.c10
-rw-r--r--tests/info.test293
12 files changed, 1290 insertions, 107 deletions
diff --git a/ChangeLog b/ChangeLog
index f982bcd..45345ea 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,28 @@
+2009-08-25 Andreas Kupries <andreask@activestate.com>
+
+ * 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.
+
2009-08-24 Daniel Steffen <das@users.sourceforge.net>
* macosx/tclMacOSXNotify.c: fix multiple issues with nested event loops
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d7cbe39..77e9a31 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.295.2.12 2009/07/23 15:23:50 das Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.295.2.13 2009/08/25 21:01:05 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -450,6 +450,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;
@@ -3954,7 +3955,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);
}
/*
@@ -4038,7 +4040,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
@@ -4052,7 +4054,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;
@@ -4080,6 +4099,23 @@ TclEvalEx(
int *linesStack = (int *) 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);
@@ -4105,12 +4141,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.
*/
if (iPtr->evalFlags & TCL_EVAL_CTX) {
@@ -4175,19 +4211,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.
@@ -4218,6 +4260,8 @@ TclEvalEx(
*/
TclAdvanceLines(&wordLine, wordStart, tokenPtr->start);
+ TclAdvanceContinuations (&wordLine, &wordCLNext,
+ tokenPtr->start - outerScript);
wordStart = tokenPtr->start;
lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
@@ -4228,7 +4272,8 @@ TclEvalEx(
}
code = TclSubstTokens(interp, tokenPtr+1,
- tokenPtr->numComponents, NULL, wordLine);
+ tokenPtr->numComponents, NULL, wordLine,
+ wordCLNext, outerScript);
iPtr->evalFlags = 0;
@@ -4260,6 +4305,11 @@ TclEvalEx(
expand[objectsUsed] = 0;
objectsNeeded++;
}
+
+ if (wordCLNext) {
+ TclContinuationsEnterDerived (objv[objectsUsed],
+ wordStart - outerScript, wordCLNext);
+ }
} /* for loop */
if (expandRequested) {
/*
@@ -4487,6 +4537,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.
@@ -5044,6 +5141,33 @@ TclEvalObjEx(
* in the bytecode compiler.
*/
+ /*
+ * 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;
+ }
+
if (invoker == NULL) {
/*
* No context, force opening of our own.
@@ -5101,7 +5225,7 @@ TclEvalObjEx(
iPtr->evalFlags |= TCL_EVAL_CTX;
result = TclEvalEx(interp, script, numSrcBytes, flags,
- ctxPtr->line[word]);
+ ctxPtr->line[word], NULL, script);
if (pc) {
/*
@@ -5112,6 +5236,16 @@ TclEvalObjEx(
}
}
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;
}
} else {
/*
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index aa12480..1ff2138 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.163.2.4 2009/07/20 09:26:16 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.163.2.5 2009/08/25 21:01:05 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -3853,7 +3853,7 @@ Tcl_SwitchObjCmd(
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
@@ -3891,7 +3891,7 @@ Tcl_SwitchObjCmd(
* TIP #280: Make invoking context available to switch branch.
*/
- result = TclEvalObjEx(interp, objv[j], 0, ctxPtr, j);
+ result = TclEvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j);
if (splitObjs) {
ckfree((char *) ctxPtr->line);
if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
@@ -4094,21 +4094,33 @@ Tcl_WhileObjCmd(
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 6a71666..d01964d 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.143.2.1 2008/05/07 10:39:38 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.143.2.2 2009/08/25 21:01:05 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -31,7 +31,8 @@
TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
(tokenPtr)[1].size), (envPtr)); \
} else { \
- envPtr->line = mapPtr->loc[eclIndex].line[word]; \
+ 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:
@@ -152,7 +157,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);
@@ -169,6 +175,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.
*/
@@ -259,9 +270,8 @@ TclCompileAppendCmd(
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
/*
* We are doing an assignment, otherwise TclCompileSetCmd was called, so
@@ -449,7 +459,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);
@@ -921,7 +931,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);
@@ -1447,7 +1457,7 @@ TclCompileForCmd(
* Inline compile the initial command.
*/
- envPtr->line = mapPtr->loc[eclIndex].line[1];
+ SetLineInformation (1);
CompileBody(envPtr, startTokenPtr, interp);
TclEmitOpcode(INST_POP, envPtr);
@@ -1470,7 +1480,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;
@@ -1482,7 +1492,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;
@@ -1503,7 +1513,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;
@@ -1753,7 +1763,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) {
@@ -1785,7 +1795,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);
@@ -2124,7 +2134,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) {
@@ -2166,7 +2176,7 @@ TclCompileIfCmd(
*/
if (compileScripts) {
- envPtr->line = mapPtr->loc[eclIndex].line[wordIdx];
+ SetLineInformation (wordIdx);
envPtr->currStackDepth = savedStackDepth;
CompileBody(envPtr, tokenPtr, interp);
}
@@ -2254,7 +2264,7 @@ TclCompileIfCmd(
* Compile the else command body.
*/
- envPtr->line = mapPtr->loc[eclIndex].line[wordIdx];
+ SetLineInformation (wordIdx);
CompileBody(envPtr, tokenPtr, interp);
}
@@ -2356,9 +2366,8 @@ TclCompileIncrCmd(
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX|TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX|TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
/*
* If an increment is given, push it, but see first if it's a small
@@ -2384,7 +2393,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. */
@@ -2499,9 +2508,8 @@ TclCompileLappendCmd(
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
/*
* If we are doing an assignment, push the new value. In the no values
@@ -2606,8 +2614,8 @@ TclCompileLassignCmd(
* Generate the next variable name.
*/
- PushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
- &simpleVarName, &isScalar, mapPtr->loc[eclIndex].line[idx+2]);
+ PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
+ &simpleVarName, &isScalar, idx+2);
/*
* Emit instructions to get the idx'th item out of the list value on
@@ -2943,9 +2951,8 @@ TclCompileLsetCmd(
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
/*
* Push the "index" args and the new element value.
@@ -3445,9 +3452,8 @@ TclCompileSetCmd(
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
/*
* If we are doing an assignment, push the new value.
@@ -3728,7 +3734,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);
@@ -3794,7 +3800,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);
}
@@ -3844,6 +3850,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. */
@@ -3862,6 +3869,7 @@ TclCompileSwitchCmd(
int isListedArms = 0;
int i, valueIndex;
DefineLineInformation; /* TIP #280 */
+ int* clNext = envPtr->clNext;
/*
* Only handle the following versions:
@@ -4040,6 +4048,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.
@@ -4083,6 +4092,7 @@ TclCompileSwitchCmd(
ckfree((char *) bodyToken);
ckfree((char *) bodyTokenArray);
ckfree((char *) bodyLines);
+ ckfree((char *) bodyNext);
return TCL_ERROR;
}
@@ -4093,7 +4103,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))) {
@@ -4121,6 +4134,7 @@ TclCompileSwitchCmd(
ckfree((char *) bodyToken);
ckfree((char *) bodyTokenArray);
ckfree((char *) bodyLines);
+ ckfree((char *) bodyNext);
return TCL_ERROR;
}
@@ -4141,6 +4155,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++) {
/*
@@ -4153,6 +4168,7 @@ TclCompileSwitchCmd(
tokenPtr->numComponents != 1) {
ckfree((char *) bodyToken);
ckfree((char *) bodyLines);
+ ckfree((char *) bodyNext);
return TCL_ERROR;
}
bodyToken[i] = tokenPtr+1;
@@ -4162,6 +4178,7 @@ TclCompileSwitchCmd(
*/
bodyLines[i] = mapPtr->loc[eclIndex].line[valueIndex+1+i];
+ bodyNext[i] = mapPtr->loc[eclIndex].next[valueIndex+1+i];
tokenPtr = TokenAfter(tokenPtr);
}
}
@@ -4175,6 +4192,7 @@ TclCompileSwitchCmd(
bodyToken[numWords-1]->start[0] == '-') {
ckfree((char *) bodyToken);
ckfree((char *) bodyLines);
+ ckfree((char *) bodyNext);
if (bodyTokenArray != NULL) {
ckfree((char *) bodyTokenArray);
}
@@ -4186,7 +4204,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);
/*
@@ -4308,6 +4326,7 @@ TclCompileSwitchCmd(
*/
envPtr->line = bodyLines[i+1]; /* TIP #280 */
+ envPtr->clNext = bodyNext[i+1]; /* TIP #280 */
TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);
/*
@@ -4359,6 +4378,7 @@ TclCompileSwitchCmd(
ckfree((char *) finalFixups);
ckfree((char *) bodyToken);
ckfree((char *) bodyLines);
+ ckfree((char *) bodyNext);
if (bodyTokenArray != NULL) {
ckfree((char *) bodyTokenArray);
}
@@ -4520,6 +4540,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) {
@@ -4536,6 +4557,7 @@ TclCompileSwitchCmd(
ckfree((char *) bodyToken);
ckfree((char *) bodyLines);
+ ckfree((char *) bodyNext);
if (bodyTokenArray != NULL) {
ckfree((char *) bodyTokenArray);
}
@@ -4792,7 +4814,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);
@@ -4812,7 +4834,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;
@@ -4877,7 +4899,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;
@@ -5061,6 +5084,7 @@ PushVarName(
if (elName != NULL) {
if (elNameChars) {
envPtr->line = line;
+ envPtr->clNext = clNext;
TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr);
} else {
PushLiteral(envPtr, "", 0);
@@ -5072,6 +5096,7 @@ PushVarName(
*/
envPtr->line = line;
+ envPtr->clNext = clNext;
CompileTokens(envPtr, varTokenPtr, interp);
}
@@ -5849,9 +5874,8 @@ TclCompileUpvarCmd(
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, 1);
- PushVarName(interp, localTokenPtr, envPtr, TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, localTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
if((localIndex < 0) || !isScalar) {
return TCL_ERROR;
@@ -5942,9 +5966,8 @@ TclCompileNamespaceCmd(
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, 1);
- PushVarName(interp, localTokenPtr, envPtr, TCL_CREATE_VAR,
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, localTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
if((localIndex < 0) || !isScalar) {
return TCL_ERROR;
@@ -6444,8 +6467,8 @@ TclCompileInfoExistsCmd(
*/
tokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
- &simpleVarName, &isScalar, mapPtr->loc[eclIndex].line[1]);
+ PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
+ &simpleVarName, &isScalar, 1);
/*
* Emit instruction to check the variable for existence.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 2ea99ac..403e487 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.146.2.10 2009/07/16 20:50:54 dgp Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.146.2.11 2009/08/25 21:01:05 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);
/*
@@ -982,6 +1003,15 @@ TclInitCompileEnv(
TclStackFree(interp, ctxPtr);
}
+ /*
+ * 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;
@@ -1036,6 +1066,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);
+ }
}
/*
@@ -1163,6 +1203,7 @@ TclCompileScript(
/* TIP #280 */
ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
int *wlines, wlineat, cmdLine;
+ int* clNext;
Tcl_Parse *parsePtr = (Tcl_Parse *)
TclStackAlloc(interp, sizeof(Tcl_Parse));
@@ -1188,6 +1229,7 @@ TclCompileScript(
p = script;
bytesLeft = numBytes;
cmdLine = envPtr->line;
+ clNext = envPtr->clNext;
do {
if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
/*
@@ -1287,10 +1329,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);
+ parsePtr->tokenPtr, parsePtr->commandStart,
+ parsePtr->commandSize, parsePtr->numWords, cmdLine,
+ clNext, &wlines, envPtr);
wlineat = eclPtr->nuloc - 1;
/*
@@ -1303,6 +1347,8 @@ 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.
@@ -1463,6 +1509,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 */
@@ -1524,7 +1576,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 */
/*
@@ -1540,6 +1594,7 @@ TclCompileScript(
*/
TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
+ TclAdvanceContinuations (&cmdLine, &clNext, p - envPtr->source);
Tcl_FreeParse(parsePtr);
} while (bytesLeft > 0);
@@ -1600,6 +1655,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
+ * 'EvalTokensStandard()' (see file "tclBasic.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;
@@ -1612,6 +1702,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:
@@ -1627,6 +1747,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,
@@ -1737,6 +1863,12 @@ TclCompileTokens(
Tcl_DStringLength(&textBuffer));
TclEmitPush(literal, envPtr);
numObjsToConcat++;
+
+ if (numCL) {
+ TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
+ numCL, clPosition);
+ }
+ numCL = 0;
}
/*
@@ -1759,6 +1891,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);
+ }
}
/*
@@ -2397,11 +2538,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) {
/*
@@ -2421,17 +2565,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);
+ 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 2eb8489..a86e8f1 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.90.2.6 2009/07/14 16:33:12 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.90.2.7 2009/08/25 21:01:05 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 {
@@ -306,6 +309,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 b7e34c9..b39eeb6 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.362.2.7 2009/07/14 16:33:12 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.362.2.8 2009/08/25 21:01:05 andreas_kupries Exp $
*/
#ifndef _TCLINT
@@ -1155,6 +1155,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'.
@@ -1866,6 +1896,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.
@@ -2457,6 +2497,7 @@ MODULE_SCOPE char tclEmptyString;
*----------------------------------------------------------------
*/
+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,
@@ -2483,11 +2524,16 @@ MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
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,
@@ -2575,8 +2621,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[],
@@ -2703,7 +2749,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 void TclTransferResult(Tcl_Interp *sourceInterp, int result,
Tcl_Interp *targetInterp);
MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData);
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 239865d..1b0a58c 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.139.2.2 2009/05/08 02:23:52 msofer Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.139.2.3 2009/08/25 21:01:05 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -53,18 +53,43 @@ Tcl_Mutex tclObjMutex;
char tclEmptyString = '\0';
char *tclEmptyStringRep = &tclEmptyString;
-
-#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.
+ * 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
@@ -420,6 +445,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 --
@@ -624,7 +956,7 @@ TclDbInitNewObj(
Tcl_HashEntry *hPtr;
Tcl_HashTable *tablePtr;
int isNew;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr = TclGetTables();
if (tsdPtr->objThreadMap == NULL) {
tsdPtr->objThreadMap = (Tcl_HashTable *)
@@ -881,6 +1213,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 */
@@ -946,6 +1300,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
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);
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 717b8bc..3c8f810 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.139.2.5 2009/06/13 14:25:13 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.139.2.6 2009/08/25 21:01:05 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -430,8 +430,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);
}
/*
@@ -2530,7 +2540,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 8f83738..3a3a10f 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.160.2.4 2009/07/16 20:50:54 dgp Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.160.2.5 2009/08/25 21:01:05 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -1878,6 +1878,14 @@ TclPtrSetVar(
} else {
if (Tcl_IsShared(oldValuePtr)) { /* Append to copy. */
varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+
+ /*
+ * TIP #280.
+ * Ensure that the continuation line data for the string
+ * is not lost and applies to the extended script as well.
+ */
+ 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 5e1e43d..90cbb24 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.47.2.8 2009/07/14 16:33:12 andreas_kupries Exp $
+# RCS: @(#) $Id: info.test,v 1.47.2.9 2009/08/25 21:01:05 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -1012,20 +1012,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]];# 1019
}
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 1019 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
# -------------------------------------------------------------------------
# See 24.0 - 24.5 for similar situations, using literal scripts.
@@ -1429,6 +1429,279 @@ type source line 1420 file info.test cmd {info frame 0} proc ::foo::bar level 0
type source line 1421 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 1439
+ }
+ }
+ set res [abra]
+ rename abra {}
+ set res
+} {type source line 1439 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 1450
+ }
+ set res
+} {type source line 1450 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 1457
+ set res
+} {type source line 1457 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 1464
+ }
+ set res
+} {type source line 1464 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 1474
+ }
+ }
+ set res
+} {type source line 1474 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 1482
+} { type source line 1482 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 1488
+ }
+ set res [abra]
+ rename abra {}
+ set res
+} { type source line 1488 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 1499
+}
+} { type source line 1499 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 1508
+}
+} { type source line 1508 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 ; #1516
+ unset tmp
+ set res
+} { type source line 1516 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 1534
+}
+} { type source line 1534 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 1543
+ }
+ }
+ set res
+} {type source line 1543 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 1555
+ }]
+ rename abra {}
+ set res
+} { type source line 1555 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 1567
+ }
+ }
+ }
+ a ; set res [b]
+ rename a {}
+ rename b {}
+ set res
+} {type source line 1567 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; # 1580 } \
+ \t### { info frame 0; # 1581 } \
+ {[0-9]*} { info frame 0; # 1582 }
+ }
+ set res {}
+ lappend res [reduce [a {key }]]
+ lappend res [reduce [a {1alpha}]]
+ set res "\n[join $res \n]"
+} {
+type source line 1580 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1582 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] ;# 1594 } \
+ \t### { } \
+ {[0-9]*} { }
+} {type source line 1594 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 1606, 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 1617 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1621 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 1636 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}
+ }
+ set res {}
+ lappend res [reduce [a 1]]
+ lappend res [reduce [a 0]]
+ set res "\n[join $res \n]"
+} {
+type source line 1645 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1646 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 ; #1661
+ unset tmp
+ set res
+ }
+ set res [a]
+ rename a {}
+ set res
+} { type source line 1661 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; # 1673 } \
+ xxx { info frame 0; # 1674 } \
+ 000 { info frame 0; # 1675 }
+ }
+ set res {}
+ lappend res [reduce [a key]]
+ lappend res [reduce [a 000]]
+ set res "\n[join $res \n]"
+} {
+type source line 1673 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1675 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 1689 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1693 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-07 06:58:36 (GMT)