diff options
| -rw-r--r-- | generic/tclCompCmds.c | 4 | ||||
| -rw-r--r-- | generic/tclCompCmdsGR.c | 2 | ||||
| -rw-r--r-- | generic/tclCompCmdsSZ.c | 2 | ||||
| -rw-r--r-- | generic/tclCompile.h | 5 | ||||
| -rw-r--r-- | generic/tclEnsemble.c | 10 | ||||
| -rw-r--r-- | tests/info.test | 29 |
6 files changed, 37 insertions, 15 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index fddf152..13318a3 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -610,7 +610,7 @@ TclCompileCatchCmd( * begin by undeflowing the stack below the mark set by BEGIN_CATCH4. */ - SetLineInformation(1); + LineInformation(1); if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); @@ -1467,7 +1467,7 @@ CompileDictEachCmd( * Compile the loop body itself. It should be stack-neutral. */ - SetLineInformation(3); + LineInformation(3); CompileBody(envPtr, bodyTokenPtr, interp); if (collect == TCL_EACH_COLLECT) { Emit14Inst( INST_LOAD_SCALAR, keyVarIndex, envPtr); diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index f7c15e6..cc3f694 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -264,7 +264,7 @@ TclCompileIfCmd( */ if (compileScripts) { - SetLineInformation(wordIdx); + LineInformation(wordIdx); CompileBody(envPtr, tokenPtr, interp); } diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 855dd8f..34c24f9 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -725,7 +725,7 @@ TclCompileSubstCmd( return TCL_ERROR; } - SetLineInformation(numArgs); + LineInformation(numArgs); TclSubstCompile(interp, wordTokenPtr[1].start, wordTokenPtr[1].size, flags, mapPtr->loc[eclIndex].line[numArgs], envPtr); diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 9af4911..5043f65 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1537,10 +1537,13 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ int eclIndex = mapPtr->nuloc - 1 -#define SetLineInformation(word) \ +#define LineInformation(word) \ envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] +#define SetLineInformation(word) + + #define PushVarNameWord(i,v,e,f,l,sc,word) \ TclPushVarName(i,v,e,f,l,sc, \ mapPtr->loc[eclIndex].line[(word)], \ diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index a718d0e..d654bbf 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -88,16 +88,6 @@ const Tcl_ObjType tclEnsembleCmdType = { NULL /* setFromAnyProc */ }; -/* - * Copied from tclCompCmds.c - */ - -#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)] static inline Tcl_Obj * NewNsObj( diff --git a/tests/info.test b/tests/info.test index ebc853a..ba31159 100644 --- a/tests/info.test +++ b/tests/info.test @@ -1962,6 +1962,35 @@ test info-9.13 {info level option, value in global context} -body { } -returnCodes error -result {bad level "2"} # ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + catch {*}{ + {info frame 0} + res + } + return $res +} +test info-33.4 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 1968 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- +namespace eval foo {} +proc foo::bar {} { + dict for {a b} {c d} {*}{ + {set res [info frame 0]} + } + return $res +} +test info-33.5 {{*}, literal, simple, bytecompiled} -body { + reduce [foo::bar] +} -cleanup { + namespace delete foo +} -result {type source line 1983 file info.test cmd {info frame 0} proc ::foo::bar level 0} + +# ------------------------------------------------------------------------- unset -nocomplain res # cleanup |