summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2009-08-25 20:59:09 (GMT)
committerandreas_kupries <akupries@shaw.ca>2009-08-25 20:59:09 (GMT)
commit290495c7ce8eaa67ffe2fa4fc3b8106742148a27 (patch)
tree4a737e378aa3ed2c71519eae3320f02faabfcc2c
parentf9ad150a1ad924f9775cf6d740e1bd5018acc492 (diff)
downloadtcl-290495c7ce8eaa67ffe2fa4fc3b8106742148a27.zip
tcl-290495c7ce8eaa67ffe2fa4fc3b8106742148a27.tar.gz
tcl-290495c7ce8eaa67ffe2fa4fc3b8106742148a27.tar.bz2
* generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard,
EvalTokensStandard, Tcl_EvalEx, EvalEx, TclAdvanceContinuations, TclEvalObjEx): * generic/tclCmdMZ.c (Tcl_SwitchObjCmd, ListLines): * 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/tclProc.c (TclCreateProc): * generic/tclVar.c (TclPtrSetVar): * tests/info.test (info-30.0-22): Extended parser, compiler, and execution with code and attendant data structures tracking the positions of continuation lines which are not visible in script's, to properly account for them while counting lines for #280, during direct and compiled execution.
Diffstat
-rw-r--r--ChangeLog24
-rw-r--r--generic/tclBasic.c300
-rw-r--r--generic/tclCmdMZ.c45
-rw-r--r--generic/tclCompCmds.c354
-rw-r--r--generic/tclCompile.c183
-rw-r--r--generic/tclCompile.h10
-rw-r--r--generic/tclExecute.c6
-rw-r--r--generic/tclInt.h62
-rw-r--r--generic/tclObj.c379
-rw-r--r--generic/tclProc.c14
-rw-r--r--generic/tclVar.c11
-rw-r--r--tests/info.test263
12 files changed, 1313 insertions, 338 deletions
diff --git a/ChangeLog b/ChangeLog
index 0b0209b..0b1281d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+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, ListLines):
+ * 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/tclProc.c (TclCreateProc):
+ * generic/tclVar.c (TclPtrSetVar):
+ * tests/info.test (info-30.0-22):
+
+ Extended parser, compiler, and execution with code and attendant
+ data structures tracking the positions of continuation lines which
+ are not visible in script's, to properly account for them while
+ counting lines for #280, during direct and compiled execution.
+
2009-08-17 Don Porter <dgp@users.sourceforge.net>
* generic/tclFileName.c: Correct result from [glob */test] when *
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 6afe56a..715af1b 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.75.2.36 2009/07/23 15:23:54 das Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.75.2.37 2009/08/25 20:59:10 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -43,13 +43,15 @@ static int StringTraceProc _ANSI_ARGS_((ClientData clientData,
static void StringTraceDeleteProc _ANSI_ARGS_((ClientData clientData));
#ifdef TCL_TIP280
-/* TIP #280 - Modified token based evulation, with line information */
+/* TIP #280 - Modified token based evaluation, with line information */
static int EvalEx _ANSI_ARGS_((Tcl_Interp *interp, CONST char *script,
- int numBytes, int flags, int line));
+ int numBytes, int flags, int line,
+ int* clNextOuter, CONST char* outerScript));
static int EvalTokensStandard _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *tokenPtr,
- int count, int line));
+ int count, int line,
+ int* clNextOuter, CONST char* outerScript));
#endif
#ifdef USE_DTRACE
@@ -365,6 +367,7 @@ Tcl_CreateInterp()
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;
#endif
iPtr->activeVarTracePtr = NULL;
@@ -3544,11 +3547,11 @@ Tcl_EvalTokensStandard(interp, tokenPtr, count)
* Must be at least 1. */
{
#ifdef TCL_TIP280
- return EvalTokensStandard (interp, tokenPtr, count, 1);
+ return EvalTokensStandard (interp, tokenPtr, count, 1, NULL, NULL);
}
static int
-EvalTokensStandard(interp, tokenPtr, count, line)
+EvalTokensStandard(interp, tokenPtr, count, line, clNextOuter, outerScript)
Tcl_Interp *interp; /* Interpreter in which to lookup
* variables, execute nested commands,
* and report errors. */
@@ -3557,6 +3560,22 @@ EvalTokensStandard(interp, tokenPtr, count, line)
int count; /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
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.
+ */
{
#endif
Tcl_Obj *resultPtr, *indexPtr, *valuePtr;
@@ -3570,6 +3589,13 @@ EvalTokensStandard(interp, tokenPtr, count, line)
char *varName, *index;
CONST char *p = NULL; /* Initialized to avoid compiler warning. */
int length, code;
+#ifdef TCL_TIP280
+#define NUM_STATIC_POS 20
+ int isLiteral, maxNumCL, numCL, i, adjust;
+ int* clPosition;
+ Interp* iPtr = (Interp*) interp;
+ int inFile = iPtr->evalFlags & TCL_EVAL_FILE;
+#endif
/*
* The only tricky thing about this procedure is that it attempts to
@@ -3581,6 +3607,32 @@ EvalTokensStandard(interp, tokenPtr, count, line)
code = TCL_OK;
resultPtr = NULL;
Tcl_ResetResult(interp);
+#ifdef TCL_TIP280
+ /*
+ * 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;
+#endif
for ( ; count > 0; count--, tokenPtr++) {
valuePtr = NULL;
@@ -3600,6 +3652,43 @@ EvalTokensStandard(interp, tokenPtr, count, line)
length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
buffer);
p = buffer;
+#ifdef TCL_TIP280
+ /*
+ * 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;
+ if (resultPtr == 0) {
+ clPos = 0;
+ } else {
+ Tcl_GetStringFromObj(resultPtr, &clPos);
+ }
+
+ if (numCL >= maxNumCL) {
+ maxNumCL *= 2;
+ clPosition = (int*) ckrealloc ((char*)clPosition,
+ maxNumCL*sizeof(int));
+ }
+ clPosition[numCL] = clPos;
+ numCL ++;
+ }
+ adjust ++;
+ }
+#endif
break;
case TCL_TOKEN_COMMAND: {
@@ -3612,8 +3701,19 @@ EvalTokensStandard(interp, tokenPtr, count, line)
tokenPtr->start+1, tokenPtr->size-2, 0);
#else
/* TIP #280: Transfer line information to nested command */
+ TclAdvanceContinuations (&line, &clNextOuter,
+ tokenPtr->start - outerScript);
code = EvalEx(interp,
- tokenPtr->start+1, tokenPtr->size-2, 0, line);
+ tokenPtr->start+1, tokenPtr->size-2, 0,
+ line + adjust, clNextOuter, outerScript);
+
+ /*
+ * Restore flag reset by the nested eval for future
+ * bracketed commands and their CmdFrame setup
+ */
+ if (inFile) {
+ iPtr->evalFlags |= TCL_EVAL_FILE;
+ }
#endif
}
iPtr->numLevels--;
@@ -3635,7 +3735,7 @@ EvalTokensStandard(interp, tokenPtr, count, line)
#else
/* TIP #280: Transfer line information to nested command */
code = EvalTokensStandard(interp, tokenPtr+2,
- tokenPtr->numComponents - 1, line);
+ tokenPtr->numComponents - 1, line, NULL, NULL);
#endif
if (code != TCL_OK) {
goto done;
@@ -3706,6 +3806,28 @@ EvalTokensStandard(interp, tokenPtr, count, line)
}
if (resultPtr != NULL) {
Tcl_SetObjResult(interp, resultPtr);
+#ifdef TCL_TIP280
+ /*
+ * 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(resultPtr, numCL, clPosition);
+ }
+
+ /*
+ * Release the temp table we used to collect the locations of
+ * continuation lines, if any.
+ */
+
+ if (maxNumCL) {
+ ckfree ((char*) clPosition);
+ }
+#endif
} else {
code = TCL_ERROR;
}
@@ -3805,11 +3927,11 @@ Tcl_EvalEx(interp, script, numBytes, flags)
* supported. */
{
#ifdef TCL_TIP280
- return EvalEx (interp, script, numBytes, flags, 1);
+ return EvalEx (interp, script, numBytes, flags, 1, NULL, script);
}
static int
-EvalEx(interp, script, numBytes, flags, line)
+EvalEx(interp, script, numBytes, flags, line, clNextOuter, outerScript)
Tcl_Interp *interp; /* Interpreter in which to evaluate the
* script. Also used for error reporting. */
CONST char *script; /* First character of script to evaluate. */
@@ -3821,6 +3943,23 @@ EvalEx(interp, script, numBytes, flags, line)
* TCL_EVAL_GLOBAL is currently
* supported. */
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.
+ */
{
#endif
Interp *iPtr = (Interp *) interp;
@@ -3846,6 +3985,24 @@ EvalEx(interp, script, numBytes, flags, line)
#ifdef TCL_TIP280
/* TIP #280 Structures for tracking of command locations. */
CmdFrame eeFrame;
+
+ /*
+ * 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];
+ }
+ }
#endif
if (numBytes < 0) {
@@ -3914,7 +4071,7 @@ EvalEx(interp, script, numBytes, flags, line)
} else {
/* Set up for plain eval */
- eeFrame.type = TCL_LOCATION_EVAL;
+ eeFrame.type = TCL_LOCATION_EVAL;
eeFrame.data.eval.path = NULL;
}
@@ -3951,21 +4108,26 @@ EvalEx(interp, script, numBytes, flags, line)
/*
* TIP #280 Track lines. The parser may have skipped text till it
* found the command we are now at. We have count the lines in this
- * block.
+ * block, and do not forget invisible continuation lines.
*/
- TclAdvanceLines (&line, p, parse.commandStart);
+ TclAdvanceLines (&line, p, parse.commandStart);
+ TclAdvanceContinuations (&line, &clNext,
+ parse.commandStart - outerScript);
#endif
if (parse.numWords > 0) {
#ifdef TCL_TIP280
/*
* TIP #280. Track lines within the words of the current
- * command.
+ * 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 = parse.commandStart;
+ int wordLine = line;
+ CONST char* wordStart = parse.commandStart;
+ int* wordCLNext = clNext;
#endif
/*
@@ -4000,10 +4162,12 @@ EvalEx(interp, script, numBytes, flags, line)
* (source vs. eval).
*/
- TclAdvanceLines (&wordLine, wordStart, tokenPtr->start);
+ TclAdvanceLines (&wordLine, wordStart, tokenPtr->start);
+ TclAdvanceContinuations (&wordLine, &wordCLNext,
+ tokenPtr->start - outerScript);
wordStart = tokenPtr->start;
- eeFrame.line [objectsUsed] = (TclWordKnownAtCompileTime (tokenPtr)
+ eeFrame.line [objectsUsed] = (TclWordKnownAtCompileTime (tokenPtr)
? wordLine
: -1);
@@ -4012,7 +4176,8 @@ EvalEx(interp, script, numBytes, flags, line)
}
code = EvalTokensStandard(interp, tokenPtr+1,
- tokenPtr->numComponents, wordLine);
+ tokenPtr->numComponents, wordLine,
+ wordCLNext, outerScript);
iPtr->evalFlags = 0;
#endif
@@ -4020,6 +4185,12 @@ EvalEx(interp, script, numBytes, flags, line)
if (code == TCL_OK) {
objv[objectsUsed] = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(objv[objectsUsed]);
+#ifdef TCL_TIP280
+ if (wordCLNext) {
+ TclContinuationsEnterDerived (objv[objectsUsed],
+ wordStart - outerScript, wordCLNext);
+ }
+#endif
} else {
goto error;
}
@@ -4314,6 +4485,53 @@ TclAdvanceLines (line,start,end)
/*
*----------------------------------------------------------------------
+ *
+ * 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.
@@ -4644,7 +4862,7 @@ TclArgumentGet(interp,obj,cfPtrPtr,wordPtr)
CFWordBC* cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr);
framePtr = cfwPtr->framePtr;
- framePtr->data.tebc.pc = ((ByteCode*)
+ framePtr->data.tebc.pc = (char*) ((ByteCode*)
framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc;
*cfPtrPtr = cfwPtr->framePtr;
*wordPtr = cfwPtr->word;
@@ -4912,6 +5130,34 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word)
* code 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 */
script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
@@ -4956,7 +5202,8 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word)
iPtr->invokeCmdFramePtr = &ctx;
iPtr->evalFlags |= TCL_EVAL_CTX;
- result = EvalEx(interp, script, numSrcBytes, flags, ctx.line [word]);
+ result = EvalEx(interp, script, numSrcBytes, flags,
+ ctx.line [word], NULL, script);
if (pc) {
/* Death of SrcInfo reference */
@@ -4964,6 +5211,16 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word)
}
}
}
+
+ /*
+ * 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;
#endif
}
} else {
@@ -6535,4 +6792,3 @@ TCL_DTRACE_DEBUG_LOG()
* fill-column: 78
* End:
*/
-
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 9114e50..ef172fc 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.82.2.29 2007/06/27 17:29:22 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.30 2009/08/25 20:59:10 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -139,8 +139,9 @@ static void TraceCommandProc _ANSI_ARGS_((ClientData clientData,
static Tcl_CmdObjTraceProc TraceExecutionProc;
#ifdef TCL_TIP280
-static void ListLines _ANSI_ARGS_((CONST char* listStr, int line,
- int n, int* lines));
+static void ListLines _ANSI_ARGS_((Tcl_Obj* listObj, int line,
+ int n, int* lines,
+ Tcl_Obj* const* elems));
#endif
/*
*----------------------------------------------------------------------
@@ -2925,7 +2926,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
ctx.line = (int*) ckalloc (objc * sizeof(int));
ctx.nline = objc;
- ListLines (Tcl_GetString (blist), bline, objc, ctx.line);
+ ListLines (blist, bline, objc, ctx.line, objv);
} else {
int k;
/* Dynamic code word ... All elements are relative to themselves */
@@ -2961,7 +2962,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
result = Tcl_EvalObjEx(interp, objv[j], 0);
#else
/* TIP #280. Make invoking context available to switch branch */
- result = TclEvalObjEx(interp, objv[j], 0, &ctx, j);
+ result = TclEvalObjEx(interp, objv[j], 0, &ctx, splitObjs ? j : bidx+j);
if (splitObjs) {
ckfree ((char*) ctx.line);
if (pc && (ctx.type == TCL_LOCATION_SOURCE)) {
@@ -4989,24 +4990,34 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv)
#ifdef TCL_TIP280
static void
-ListLines(listStr, line, n, lines)
- CONST char* listStr; /* Pointer to 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 */
+ListLines(listObj, line, n, lines, elems)
+ 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 */
+ Tcl_Obj* const* elems; /* The list elems as Tcl_Obj*, in need of derived
+ * continuation data */
{
- int i;
- int length = strlen( listStr);
- CONST char *element = NULL;
- CONST char* next = NULL;
+ int i;
+ CONST char* listStr = Tcl_GetString (listObj);
+ CONST char* listHead = listStr;
+ int length = strlen( listStr);
+ CONST char* element = NULL;
+ CONST char* 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 (clNext) {
+ TclContinuationsEnterDerived (elems[i], element - listHead, clNext);
+ }
+
lines [i] = line;
length -= (next - listStr);
TclAdvanceLines (&line, element, next); /* Element */
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 3c83a58..26c387b 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.39.2.7 2008/07/21 19:37:42 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.39.2.8 2009/08/25 20:59:10 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -27,11 +27,37 @@ static void FreeForeachInfo _ANSI_ARGS_((ClientData clientData));
static int TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr));
+
+#define TclPushVarNameWord(i,v,e,f,l,s,sc,word) \
+ TclPushVarName (i,v,e,f,l,s,sc) /* ignoring word */
+
+#define DefineLineInformation /**/
+#define SetLineInformation(word) /**/
#else
static int TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr,
- int line));
+ int line, int* clNext));
+
+#define TclPushVarNameWord(i,v,e,f,l,s,sc,word) \
+ TclPushVarName (i,v,e,f,l,s,sc, \
+ mapPtr->loc [eclIndex].line [(word)], \
+ mapPtr->loc [eclIndex].next [(word)])
+
+/* TIP #280 : Remember the per-word line information of the current
+ * command. An index is used instead of a pointer as recursive compilation may
+ * reallocate, i.e. move, the array. This is also the reason to save the nuloc
+ * now, it may change during the course of the function.
+ *
+ * Macros to encapsulate the variable definition and setup, and their use.
+ */
+#define DefineLineInformation \
+ 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)]
#endif
/*
@@ -85,15 +111,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
int simpleVarName, isScalar, localIndex, numWords;
int code = TCL_OK;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
numWords = parsePtr->numWords;
if (numWords == 1) {
@@ -125,13 +143,8 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
-#ifndef TCL_TIP280
- &localIndex, &simpleVarName, &isScalar);
-#else
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc [eclIndex].line [1]);
-#endif
+ code = TclPushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
if (code != TCL_OK) {
goto done;
}
@@ -148,9 +161,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -271,15 +282,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
int code;
int savedStackDepth = envPtr->currStackDepth;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
Tcl_ResetResult(interp);
@@ -343,9 +346,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
* errors in the substitution are not catched [Bug 219184]
*/
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [1];
-#endif
+ SetLineInformation (1);
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
startOffset = (envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr);
@@ -493,6 +494,8 @@ TclCompileExprCmd(interp, parsePtr, envPtr)
{
Tcl_Token *firstWordPtr;
+ DefineLineInformation;
+
if (parsePtr->numWords == 1) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -500,11 +503,7 @@ TclCompileExprCmd(interp, parsePtr, envPtr)
return TCL_ERROR;
}
-#ifdef TCL_TIP280
- /* TIP #280 : Use the per-word line information of the current command.
- */
- envPtr->line = envPtr->extCmdMapPtr->loc [envPtr->extCmdMapPtr->nuloc - 1].line [1];
-#endif
+ SetLineInformation (1);
firstWordPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1),
@@ -543,15 +542,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
if (parsePtr->numWords != 5) {
Tcl_ResetResult(interp);
@@ -601,9 +592,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
* Inline compile the initial command.
*/
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [1];
-#endif
+ SetLineInformation (1);
code = TclCompileCmdWord(interp, startTokenPtr+1,
startTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -635,9 +624,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [4];
-#endif
+ SetLineInformation (4);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
@@ -660,9 +647,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
nextCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [3];
-#endif
+ SetLineInformation (3);
envPtr->currStackDepth = savedStackDepth;
code = TclCompileCmdWord(interp, nextTokenPtr+1,
nextTokenPtr->numComponents, envPtr);
@@ -693,9 +678,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
nextCodeOffset += 3;
testCodeOffset += 3;
}
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
envPtr->currStackDepth = savedStackDepth;
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (code != TCL_OK) {
@@ -786,14 +769,8 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
+ DefineLineInformation;
#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
int bodyIndex;
#endif
@@ -976,9 +953,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
i < numWords-1;
i++, tokenPtr += (tokenPtr->numComponents + 1)) {
if ((i%2 == 0) && (i > 0)) {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
code = TclCompileTokens(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -1016,9 +991,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
* Inline compile the loop body.
*/
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [bodyIndex];
-#endif
+ SetLineInformation (bodyIndex);
envPtr->exceptArrayPtr[range].codeOffset =
(envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
@@ -1248,15 +1221,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
int boolVal; /* value of static condition */
int compileScripts = 1;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
/*
* Only compile the "if" command if all arguments are simple
@@ -1339,9 +1304,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
}
} else {
Tcl_ResetResult(interp);
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [wordIdx];
-#endif
+ SetLineInformation (wordIdx);
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
@@ -1398,9 +1361,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
*/
if (compileScripts) {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [wordIdx];
-#endif
+ SetLineInformation (wordIdx);
envPtr->currStackDepth = savedStackDepth;
code = TclCompileCmdWord(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
@@ -1503,9 +1464,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
/*
* Compile the else command body.
*/
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [wordIdx];
-#endif
+ SetLineInformation (wordIdx);
code = TclCompileCmdWord(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -1617,15 +1576,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
int code = TCL_OK;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
Tcl_ResetResult(interp);
@@ -1637,14 +1588,9 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- code = TclPushVarName(interp, varTokenPtr, envPtr,
+ code = TclPushVarNameWord(interp, varTokenPtr, envPtr,
(TCL_NO_LARGE_INDEX | TCL_CREATE_VAR),
-#ifndef TCL_TIP280
- &localIndex, &simpleVarName, &isScalar);
-#else
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc [eclIndex].line [1]);
-#endif
+ &localIndex, &simpleVarName, &isScalar, 1);
if (code != TCL_OK) {
goto done;
}
@@ -1684,9 +1630,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
TclRegisterNewLiteral(envPtr, word, numBytes), envPtr);
}
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
code = TclCompileTokens(interp, incrTokenPtr+1,
incrTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -1779,15 +1723,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
int simpleVarName, isScalar, localIndex, numWords;
int code = TCL_OK;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
/*
* If we're not in a procedure, don't compile.
@@ -1821,13 +1757,8 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
-#ifndef TCL_TIP280
- &localIndex, &simpleVarName, &isScalar);
-#else
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc [eclIndex].line [1]);
-#endif
+ code = TclPushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
if (code != TCL_OK) {
goto done;
}
@@ -1843,9 +1774,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -1923,15 +1852,7 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
Tcl_Token *varTokenPtr;
int code, i;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
int numWords;
numWords = parsePtr->numWords;
@@ -1957,9 +1878,7 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2013,15 +1932,7 @@ TclCompileListCmd(interp, parsePtr, envPtr)
* command created by Tcl_ParseCommand. */
CompileEnv *envPtr; /* Holds resulting instructions. */
{
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
/*
* If we're not in a procedure, don't compile.
@@ -2052,9 +1963,7 @@ TclCompileListCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2100,15 +2009,7 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr)
Tcl_Token *varTokenPtr;
int code;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
if (parsePtr->numWords != 2) {
Tcl_SetResult(interp, "wrong # args: should be \"llength list\"",
@@ -2126,9 +2027,7 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [1];
-#endif
+ SetLineInformation (1);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2204,15 +2103,7 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
int i;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
/* Check argument count */
@@ -2231,13 +2122,8 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- result = TclPushVarName( interp, varTokenPtr, envPtr,
-#ifndef TCL_TIP280
- TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar );
-#else
- TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc [eclIndex].line [1]);
-#endif
+ result = TclPushVarNameWord( interp, varTokenPtr, envPtr,
+ TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar, 1);
if (result != TCL_OK) {
return result;
}
@@ -2256,9 +2142,7 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
TclEmitPush(TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
result = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if ( result != TCL_OK ) {
@@ -2389,15 +2273,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr)
int i, len, code, nocase, anchorLeft, anchorRight, start;
char *str;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
/*
* We are only interested in compiling simple regexp cases.
@@ -2546,9 +2422,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [parsePtr->numWords-1];
-#endif
+ SetLineInformation (parsePtr->numWords-1);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2599,15 +2473,7 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
int code;
int index = envPtr->exceptArrayNext - 1;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
/*
* If we're not in a procedure, don't compile.
@@ -2666,9 +2532,7 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
* "return" will be byte-compiled; otherwise it will be
* out line compiled.
*/
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [1];
-#endif
+ SetLineInformation (1);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2729,15 +2593,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
int isAssignment, isScalar, simpleVarName, localIndex, numWords;
int code = TCL_OK;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
numWords = parsePtr->numWords;
if ((numWords != 2) && (numWords != 3)) {
@@ -2759,13 +2615,8 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
-#ifndef TCL_TIP280
- &localIndex, &simpleVarName, &isScalar);
-#else
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc [eclIndex].line [1]);
-#endif
+ code = TclPushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
if (code != TCL_OK) {
goto done;
}
@@ -2780,9 +2631,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start,
valueTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2885,15 +2734,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
STR_WORDEND, STR_WORDSTART
};
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
if (parsePtr->numWords < 2) {
/* Fail at run time, not in compilation */
@@ -2956,9 +2797,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2989,9 +2828,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -3022,9 +2859,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr);
return TCL_OK;
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -3082,9 +2917,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
TclEmitPush(
TclRegisterNewLiteral(envPtr, str, length), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -3201,15 +3034,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
Tcl_Obj *boolObj;
int boolVal;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
if (parsePtr->numWords != 3) {
Tcl_ResetResult(interp);
@@ -3296,9 +3121,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
* Compile the loop body.
*/
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
@@ -3328,9 +3151,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
testCodeOffset += 3;
}
envPtr->currStackDepth = savedStackDepth;
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [1];
-#endif
+ SetLineInformation (1);
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
@@ -3406,7 +3227,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
#ifndef TCL_TIP280
simpleVarNamePtr, isScalarPtr)
#else
- simpleVarNamePtr, isScalarPtr, line)
+ simpleVarNamePtr, isScalarPtr, line, clNext)
#endif
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Token *varTokenPtr; /* Points to a variable token. */
@@ -3418,6 +3239,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
int *isScalarPtr; /* must not be NULL */
#ifdef TCL_TIP280
int line; /* line the token starts on */
+ int* clNext;
#endif
{
register CONST char *p;
@@ -3601,7 +3423,8 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
if (elName != NULL) {
if (elNameChars) {
#ifdef TCL_TIP280
- envPtr->line = line;
+ envPtr->line = line;
+ envPtr->clNext = clNext;
#endif
code = TclCompileTokens(interp, elemTokenPtr,
elemTokenCount, envPtr);
@@ -3618,7 +3441,8 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
*/
#ifdef TCL_TIP280
- envPtr->line = line;
+ envPtr->line = line;
+ envPtr->clNext = clNext;
#endif
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index b6d486e..aa25f26 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.43.2.15 2009/07/14 16:31:49 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.43.2.16 2009/08/25 20:59:10 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -307,7 +307,7 @@ static int SetByteCodeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
static void EnterCmdWordData _ANSI_ARGS_((
ExtCmdLoc *eclPtr, int srcOffset, Tcl_Token* tokenPtr,
CONST char* cmd, int len, int numWords, int line,
- int** lines));
+ int* clNext, int** lines, CompileEnv* envPtr));
#endif
@@ -367,7 +367,9 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
register int i;
int length, nested, result;
char *string;
-
+#ifdef TCL_TIP280
+ ContLineLoc* clLocPtr;
+#endif
#ifdef TCL_COMPILE_DEBUG
if (!traceInitialized) {
if (Tcl_LinkVar(interp, "tcl_traceCompile",
@@ -396,6 +398,24 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
TclInitCompileEnv(interp, &compEnv, string, 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);
+ }
#endif
result = TclCompileScript(interp, string, length, nested, &compEnv);
@@ -872,6 +892,15 @@ TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word)
/* ctx going out of scope */
}
+
+ /*
+ * 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;
#endif
envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
@@ -921,6 +950,17 @@ TclFreeCompileEnv(envPtr)
if (envPtr->mallocedAuxDataArray) {
ckfree((char *) envPtr->auxDataArrayPtr);
}
+#ifdef TCL_TIP280
+ /*
+ * 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);
+ }
+#endif
}
#ifdef TCL_TIP280
@@ -1030,6 +1070,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
int* wlines;
int wlineat, cmdLine;
+ int* clNext;
#endif
Tcl_DStringInit(&ds);
@@ -1050,6 +1091,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
gotParse = 0;
#ifdef TCL_TIP280
cmdLine = envPtr->line;
+ clNext = envPtr->clNext;
#endif
do {
@@ -1169,10 +1211,13 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
* 'wlines'.
*/
- TclAdvanceLines (&cmdLine, p, parse.commandStart);
+ TclAdvanceLines (&cmdLine, p, parse.commandStart);
+ TclAdvanceContinuations (&cmdLine, &clNext,
+ parse.commandStart - envPtr->source);
EnterCmdWordData (eclPtr, (parse.commandStart - envPtr->source),
- parse.tokenPtr, parse.commandStart, parse.commandSize,
- parse.numWords, cmdLine, &wlines);
+ parse.tokenPtr, parse.commandStart,
+ parse.commandSize, parse.numWords,
+ cmdLine, clNext, &wlines, envPtr);
wlineat = eclPtr->nuloc - 1;
#endif
@@ -1180,7 +1225,8 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
wordIdx < parse.numWords;
wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
#ifdef TCL_TIP280
- envPtr->line = eclPtr->loc [wlineat].line [wordIdx];
+ envPtr->line = eclPtr->loc [wlineat].line [wordIdx];
+ envPtr->clNext = eclPtr->loc [wlineat].next [wordIdx];
#endif
if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
/*
@@ -1268,6 +1314,13 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
objIndex = TclRegisterNewLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size);
+#ifdef TCL_TIP280
+ if (envPtr->clNext) {
+ TclContinuationsEnterDerived (envPtr->literalArrayPtr[objIndex].objPtr,
+ tokenPtr[1].start - envPtr->source,
+ eclPtr->loc [wlineat].next [wordIdx]);
+ }
+#endif
}
TclEmitPush(objIndex, envPtr);
} else {
@@ -1320,7 +1373,9 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
* the reduced form now
*/
ckfree ((char*) eclPtr->loc [wlineat].line);
- eclPtr->loc [wlineat].line = wlines;
+ ckfree ((char*) eclPtr->loc [wlineat].next);
+ eclPtr->loc [wlineat].line = wlines;
+ eclPtr->loc [wlineat].next = NULL;
#endif
} /* end if parse.numWords > 0 */
@@ -1333,7 +1388,8 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
p = next;
#ifdef TCL_TIP280
/* TIP #280 : Track lines in the just compiled command */
- TclAdvanceLines (&cmdLine, parse.commandStart, p);
+ TclAdvanceLines (&cmdLine, parse.commandStart, p);
+ TclAdvanceContinuations (&cmdLine, &clNext, p - envPtr->source);
#endif
Tcl_FreeParse(&parse);
gotParse = 0;
@@ -1440,6 +1496,43 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
int numObjsToConcat, nameBytes, localVarName, localVar;
int length, i, code;
unsigned char *entryCodeNext = envPtr->codeNext;
+#ifdef TCL_TIP280
+#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));
+ }
+#endif
Tcl_DStringInit(&textBuffer);
numObjsToConcat = 0;
@@ -1454,6 +1547,38 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
buffer);
Tcl_DStringAppend(&textBuffer, buffer, length);
+
+#ifdef TCL_TIP280
+ /*
+ * 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 ++;
+ }
+ }
+#endif
break;
case TCL_TOKEN_COMMAND:
@@ -1470,6 +1595,13 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
TclEmitPush(literal, envPtr);
numObjsToConcat++;
Tcl_DStringFree(&textBuffer);
+#ifdef TCL_TIP280
+ if (numCL) {
+ TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
+ numCL, clPosition);
+ }
+ numCL = 0;
+#endif
}
code = TclCompileScript(interp, tokenPtr->start+1,
@@ -1594,6 +1726,14 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
+
+#ifdef TCL_TIP280
+ if (numCL) {
+ TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
+ numCL, clPosition);
+ }
+ numCL = 0;
+#endif
}
/*
@@ -1616,11 +1756,20 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
envPtr);
}
- Tcl_DStringFree(&textBuffer);
- return TCL_OK;
+ code = TCL_OK;
error:
Tcl_DStringFree(&textBuffer);
+#ifdef TCL_TIP280
+ /*
+ * Release the temp table we used to collect the locations of
+ * continuation lines, if any.
+ */
+
+ if (maxNumCL) {
+ ckfree ((char*) clPosition);
+ }
+#endif
return code;
}
@@ -2426,7 +2575,7 @@ EnterCmdExtentData(envPtr, cmdIndex, numSrcBytes, numCodeBytes)
*/
static void
-EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, wlines)
+EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, clNext, wlines, envPtr)
ExtCmdLoc *eclPtr; /* Points to the map environment
* structure in which to enter command
* location information. */
@@ -2436,12 +2585,15 @@ EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, wlines)
int len;
int numWords;
int line;
+ int* clNext;
int** wlines;
+ CompileEnv* envPtr;
{
ECL* ePtr;
int wordIdx;
CONST char* last;
int wordLine;
+ int* wordNext;
int* wwlines;
if (eclPtr->nuloc >= eclPtr->nloc) {
@@ -2475,19 +2627,24 @@ EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, wlines)
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)
? wordLine
: -1);
ePtr->line [wordIdx] = wordLine;
+ ePtr->next [wordIdx] = wordNext;
last = tokenPtr->start;
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index b3431f8..37b8295 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.33.2.7 2009/07/14 16:31:49 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.33.2.8 2009/08/25 20:59:11 andreas_kupries Exp $
*/
#ifndef _TCLCOMPILATION
@@ -139,6 +139,7 @@ typedef struct ECL {
int srcOffset; /* cmd location to find the entry */
int nline; /* Number of words in the command */
int* line; /* line information for all words in the command */
+ int** next; /* Transient information during compile, ICL tracking */
} ECL;
typedef struct ExtCmdLoc {
@@ -307,6 +308,13 @@ typedef struct CompileEnv {
int line; /* First line of the script, based on the
* invoking context, then the line of the
* command currently compiled. */
+ 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. */
#endif
} CompileEnv;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 8dcf877..78e823a 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.94.2.29 2009/07/14 16:31:49 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.94.2.30 2009/08/25 20:59:11 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -1580,7 +1580,7 @@ TclExecuteByteCode(interp, codePtr)
*/
#ifdef TCL_TIP280
- bcFrame.data.tebc.pc = pc;
+ bcFrame.data.tebc.pc = (char*) pc;
iPtr->cmdFramePtr = &bcFrame;
TclArgumentBCEnter((Tcl_Interp*) iPtr, objv, objc,
codePtr, &bcFrame,
@@ -4835,7 +4835,7 @@ TclGetSrcInfoForPc (cfPtr)
ByteCode* codePtr = (ByteCode*) cfPtr->data.tebc.codePtr;
if (cfPtr->cmd.str.cmd == NULL) {
- cfPtr->cmd.str.cmd = GetSrcInfoForPc((char*) cfPtr->data.tebc.pc,
+ cfPtr->cmd.str.cmd = GetSrcInfoForPc((unsigned char*) cfPtr->data.tebc.pc,
codePtr,
&cfPtr->cmd.str.len);
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index fc56e6e..e80f0d4 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.118.2.34 2009/07/14 16:31:49 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.118.2.35 2009/08/25 20:59:11 andreas_kupries Exp $
*/
#ifndef _TCLINT
@@ -923,6 +923,37 @@ typedef struct CFWordBC {
int word; /* Index of word in ExtCmdLoc.loc[cmd]->{line,literal}[.] */
struct CFWordBC* prevPtr;
} 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
+ * EvalTokensStandard() in the file "tclBasic.c" and its caller EvalEx(), 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 CLL_END is put after the last
+ * location, as end-marker/sentinel. */
+} ContLineLoc;
+
#endif /* TCL_TIP280 */
/*
@@ -1531,6 +1562,16 @@ typedef struct Interp {
* 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.
+ */
#endif
#ifdef TCL_TIP268
/*
@@ -1848,6 +1889,16 @@ extern char tclEmptyString;
#ifdef TCL_TIP280
EXTERN void TclAdvanceLines _ANSI_ARGS_((int* line, CONST char* start,
CONST char* end));
+EXTERN void TclAdvanceContinuations _ANSI_ARGS_((int* line, int** next,
+ int loc));
+EXTERN ContLineLoc* TclContinuationsEnter _ANSI_ARGS_((Tcl_Obj* objPtr, int num,
+ int* loc));
+EXTERN void TclContinuationsEnterDerived _ANSI_ARGS_((Tcl_Obj* objPtr,
+ int start, int* clNext));
+EXTERN ContLineLoc* TclContinuationsGet _ANSI_ARGS_((Tcl_Obj* objPtr));
+
+EXTERN void TclContinuationsCopy _ANSI_ARGS_((Tcl_Obj* objPtr, Tcl_Obj* originObjPtr));
+
#endif
EXTERN int TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
@@ -2593,4 +2644,11 @@ extern Tcl_Mutex tclObjMutex;
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TCLINT */
-
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 16454ac..84d980e 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.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: tclObj.c,v 1.42.2.16 2007/10/03 12:53:12 msofer Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.42.2.17 2009/08/25 20:59:11 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -51,6 +51,38 @@ Tcl_Mutex tclObjMutex;
char tclEmptyString = '\0';
char *tclEmptyStringRep = &tclEmptyString;
+
+#ifdef TCL_TIP280
+/*
+ * 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.
+ */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+static void ContLineLocFree _ANSI_ARGS_((char* clientData));
+static void TclThreadFinalizeObjects _ANSI_ARGS_((ClientData clientData));
+static ThreadSpecificData* TclGetContinuationTable _ANSI_ARGS_(());
+#endif
+
/*
* Prototypes for procedures defined later in this file:
*/
@@ -307,6 +339,319 @@ TclFinalizeObjects()
Tcl_MutexUnlock(&tclObjMutex);
}
+#ifdef TCL_TIP280
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetContinuationTable --
+ *
+ * This procedure is a helper which returns the thread-specific
+ * hash-table used to track continuation line information associated with
+ * Tcl_Obj*.
+ *
+ * Results:
+ * A reference to the continuation line thread-data.
+ *
+ * Side effects:
+ * May allocate memory for the thread-data.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+static ThreadSpecificData*
+TclGetContinuationTable()
+{
+ /*
+ * 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);
+ }
+ 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(objPtr,num,loc)
+ Tcl_Obj* objPtr;
+ int num;
+ int* loc;
+{
+ int newEntry;
+ ThreadSpecificData *tsdPtr = TclGetContinuationTable();
+ 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(objPtr, start, clNext)
+ Tcl_Obj* objPtr;
+ int start;
+ int* clNext;
+{
+ /*
+ * We have to handle invisible continuations lines here as well, despite
+ * the code we have in EvalTokensStandard (ETS) for that. Why ?
+ * Nesting. If our script is the sole argument to an 'eval' command, for
+ * example, the scriptCLLocPtr we are using here was generated by a
+ * previous call to ETS, and while the words we have here may contain
+ * continuation lines they are invisible already, and the call to ETS
+ * above 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 = TclGetContinuationTable();
+ 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(objPtr)
+ Tcl_Obj* objPtr;
+{
+ ThreadSpecificData *tsdPtr = TclGetContinuationTable();
+ 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 clientData;
+{
+ /*
+ * Release the hashtable tracking invisible continuation lines.
+ */
+
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch hSearch;
+ ThreadSpecificData *tsdPtr = TclGetContinuationTable();
+
+ 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 (clientData)
+ char* clientData;
+{
+ ckfree (clientData);
+}
+#endif
/*
*--------------------------------------------------------------
*
@@ -700,6 +1045,29 @@ TclFreeObj(objPtr)
Tcl_MutexUnlock(&tclObjMutex);
#endif /* TCL_MEM_DEBUG */
+#ifdef TCL_TIP280
+ /*
+ * 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
TclIncrObjsFreed();
}
@@ -3280,3 +3648,12 @@ SetCmdNameFromAny(interp, objPtr)
objPtr->typePtr = &tclCmdNameType;
return TCL_OK;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
+
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 1e9f6b4..8ceb184 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.44.2.10 2009/06/13 14:38:44 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.44.2.11 2009/08/25 20:59:11 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -366,8 +366,20 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
*/
if (Tcl_IsShared(bodyPtr)) {
+#ifdef TCL_TIP280
+ Tcl_Obj* sharedBodyPtr = bodyPtr;
+#endif
bytes = Tcl_GetStringFromObj(bodyPtr, &length);
bodyPtr = Tcl_NewStringObj(bytes, length);
+#ifdef TCL_TIP280
+ /*
+ * 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);
+#endif
}
/*
diff --git a/generic/tclVar.c b/generic/tclVar.c
index b29400e..78505ff 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.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: tclVar.c,v 1.69.2.14 2007/05/10 18:23:58 dgp Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.69.2.15 2009/08/25 20:59:11 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -1659,6 +1659,15 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
} else {
if (Tcl_IsShared(oldValuePtr)) { /* append to copy */
varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+#ifdef TCL_TIP280
+ /*
+ * 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);
+#endif
TclDecrRefCount(oldValuePtr);
oldValuePtr = varPtr->value.objPtr;
Tcl_IncrRefCount(oldValuePtr); /* since var is ref */
diff --git a/tests/info.test b/tests/info.test
index b655e30..21e4f75 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.24.2.12 2009/07/14 16:31:49 andreas_kupries Exp $
+# RCS: @(#) $Id: info.test,v 1.24.2.13 2009/08/25 20:59:11 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -790,7 +790,7 @@ test info-22.8 {info frame, basic trace} -constraints {tip280} -match glob -body
join [lrange [etrace] 0 1] \n
} -result {* {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 790 file info.test cmd etrace proc ::tcltest::RunTest}}
-## The line 1966 is off by 5 from the true value of 1971. This is a knownBug, see testcase 30.0
+
test info-23.0.0 {eval'd info frame} {tip280 && !singleTestInterp} {
eval {info frame}
} 8
@@ -835,7 +835,7 @@ test info-23.6 {eval'd info frame, trace} -constraints {tip280} -match glob -bod
} -result {* {type source line 723 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
* {type source line 834 file info.test cmd {eval $script} proc ::tcltest::RunTest}}
-## The line 1966 is off by 5 from the true value of 1971. This is a knownBug, see testcase 30.0
+
# -------------------------------------------------------------------------
# Procedures defined in scripts which are arguments to control
@@ -945,20 +945,20 @@ test info-25.1 {info frame, regular proc} tip280 {
rename bar {}
-
-test info-30.0 {bs+nl in literal words} {tip280 knownBug} {
+# More info-30.x test cases at the end of the file.
+test info-30.0 {bs+nl in literal words} {tip280} {
if {1} {
set res \
- [reduce [info frame 0]]
+ [reduce [info frame 0]];# line 952
}
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 952 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
@@ -1223,6 +1223,245 @@ type source line 1214 file info.test cmd {info frame 0} proc ::foo::bar level 0
type source line 1215 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} {tip280} {
+ proc abra {} {
+ if {1} \
+ {
+ return \
+ [reduce [info frame 0]];# line 1233
+ }
+ }
+ set res [abra]
+ rename abra {}
+ set res
+} {type source line 1233 file info.test cmd {info frame 0} proc ::abra level 0}
+
+test info-30.2 {bs+nl in literal words, namespace script} {tip280} {
+ namespace eval xxx {
+ set res \
+ [reduce [info frame 0]];# line 1244
+ }
+ set res
+} {type source line 1244 file info.test cmd {info frame 0} level 0}
+
+test info-30.3 {bs+nl in literal words, namespace multi-word script} {tip280} {
+ namespace eval xxx set res \
+ [list [reduce [info frame 0]]];# line 1251
+ set res
+} {type source line 1251 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.4 {bs+nl in literal words, eval script} {tip280} {
+ eval {
+ set ::res \
+ [reduce [info frame 0]];# line 1258
+ }
+ set res
+} {type source line 1258 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.5 {bs+nl in literal words, eval script, with nested words} {tip280} {
+ eval {
+ if {1} \
+ {
+ set ::res \
+ [reduce [info frame 0]];# line 1268
+ }
+ }
+ set res
+} {type source line 1268 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.6 {bs+nl in computed word} {tip280} {
+ set res "\
+[reduce [info frame 0]]";# line 1276
+} { type source line 1276 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.7 {bs+nl in computed word, in proc} {tip280} {
+ proc abra {} {
+ return "\
+[reduce [info frame 0]]";# line 1282
+ }
+ set res [abra]
+ rename abra {}
+ set res
+} { type source line 1282 file info.test cmd {info frame 0} proc ::abra level 0}
+
+test info-30.8 {bs+nl in computed word, nested eval} {tip280} {
+ eval {
+ set \
+ res "\
+[reduce [info frame 0]]";# line 1293
+}
+} { type source line 1293 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.9 {bs+nl in computed word, nested eval} {tip280} {
+ eval {
+ set \
+ res "\
+[reduce \
+ [info frame 0]]";# line 1302
+}
+} { type source line 1302 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.10 {bs+nl in computed word, key to array} {tip280} {
+ set tmp([set \
+ res "\
+[reduce \
+ [info frame 0]]"]) x ; #1310
+ unset tmp
+ set res
+} { type source line 1310 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.11 {bs+nl in subst arguments, no true counting} {tip280} {
+ subst {[set \
+ res "\
+[reduce \
+ [info frame 0]]"]}
+} { type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.12 {bs+nl in computed word, nested eval} {tip280} {
+ eval {
+ set \
+ res "\
+[set x {}] \
+[reduce \
+ [info frame 0]]";# line 1328
+}
+} { type source line 1328 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.13 {bs+nl in literal words, uplevel script, with nested words} {tip280} {
+ uplevel #0 {
+ if {1} \
+ {
+ set ::res \
+ [reduce [info frame 0]];# line 1337
+ }
+ }
+ set res
+} {type source line 1337 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.14 {bs+nl, literal word, uplevel through proc} {tip280} {
+ proc abra {script} {
+ uplevel 1 $script
+ }
+ set res [abra {
+ return "\
+[reduce [info frame 0]]";# line 1349
+ }]
+ rename abra {}
+ set res
+} { type source line 1349 file info.test cmd {info frame 0} proc ::abra}
+
+test info-30.15 {bs+nl in literal words, nested proc body, compiled} {tip280} {
+ proc a {} {
+ proc b {} {
+ if {1} \
+ {
+ return \
+ [reduce [info frame 0]];# line 1361
+ }
+ }
+ }
+ a ; set res [b]
+ rename a {}
+ rename b {}
+ set res
+} {type source line 1361 file info.test cmd {info frame 0} proc ::b level 0}
+
+test info-30.16 {bs+nl in multi-body switch, compiled} {tip280} {
+ proc a {value} {
+ switch -regexp -- $value \
+ ^key { info frame 0; # 1374 } \
+ \t { info frame 0; # 1375 } \
+ {[0-9]*} { info frame 0; # 1376 }
+ }
+ set res {}
+ lappend res [reduce [a {key }]]
+ lappend res [reduce [a {1alpha}]]
+ set res "\n[join $res \n]"
+} {
+type source line 1374 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1376 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.17 {bs+nl in multi-body switch, direct} {tip280} {
+ switch -regexp -- {key } \
+ ^key { reduce [info frame 0] ;# 1388 } \
+ \t### { } \
+ {[0-9]*} { }
+} {type source line 1388 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} {tip280} {
+ proc abra {script} {
+ append script "\n# end of script"
+ uplevel 1 $script
+ }
+ set res [abra {
+ return "\
+[reduce [info frame 0]]";# line 1400, still line of 3 appended script
+ }]
+ rename abra {}
+ set res
+} { type eval line 3 cmd {info frame 0} proc ::abra}
+# { type source line 1400 file info.test cmd {info frame 0} proc ::abra}
+
+test info-30.19 {bs+nl in single-body switch, compiled} {tip280} {
+ 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 1411 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1415 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.20 {bs+nl in single-body switch, direct} {tip280} {
+ switch -regexp -- {key } { \
+
+ ^key { reduce \
+ [info frame 0] }
+ \t { }
+ {[0-9]*} { }
+ }
+} {type source line 1430 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.21 {bs+nl in if, full compiled} {tip280} {
+ 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 1439 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1440 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.22 {bs+nl in computed word, key to array, compiled} {tip280} {
+ proc a {} {
+ set tmp([set \
+ res "\
+[reduce \
+ [info frame 0]]"]) x ; #1454
+ unset tmp
+ set res
+ }
+ set res [a]
+ rename a {}
+ set res
+} { type source line 1455 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-06-28 20:53:25 (GMT)