diff options
| -rw-r--r-- | ChangeLog | 24 | ||||
| -rw-r--r-- | generic/tclBasic.c | 300 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 45 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 354 | ||||
| -rw-r--r-- | generic/tclCompile.c | 183 | ||||
| -rw-r--r-- | generic/tclCompile.h | 10 | ||||
| -rw-r--r-- | generic/tclExecute.c | 6 | ||||
| -rw-r--r-- | generic/tclInt.h | 62 | ||||
| -rw-r--r-- | generic/tclObj.c | 379 | ||||
| -rw-r--r-- | generic/tclProc.c | 14 | ||||
| -rw-r--r-- | generic/tclVar.c | 11 | ||||
| -rw-r--r-- | tests/info.test | 263 |
12 files changed, 1313 insertions, 338 deletions
@@ -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} |