merge trunk

4 files changed, 447 insertions, 61 deletions

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 18295eb..b1faa53 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -2464,7 +2464,7 @@ CompileEachloopCmd(
     Tcl_Token *tokenPtr, *bodyTokenPtr;
     unsigned char *jumpPc;
     JumpFixup jumpFalseFixup;
-    int jumpBackDist, jumpBackOffset, infoIndex, range, bodyIndex;
+    int jumpBackDist, jumpBackOffset, infoIndex, range;
     int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
     DefineLineInformation;	/* TIP #280 */
 
@@ -2504,8 +2504,6 @@ CompileEachloopCmd(
 	return TCL_ERROR;
     }
 
-    bodyIndex = i-1;
-
     /*
      * Allocate storage for the varcList and varvList arrays if necessary.
      */
@@ -2684,7 +2682,7 @@ CompileEachloopCmd(
      * Inline compile the loop body.
      */
 
-    SetLineInformation(bodyIndex);
+    SetLineInformation(numWords - 1);
     ExceptionRangeStarts(envPtr, range);
     CompileBody(envPtr, bodyTokenPtr, interp);
     ExceptionRangeEnds(envPtr, range);
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 026b214..58a5ba5 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -40,17 +40,14 @@ static int		CompileUnaryOpCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, int instruction,
 			    CompileEnv *envPtr);
 static void		IssueSwitchChainedTests(Tcl_Interp *interp,
-			    CompileEnv *envPtr, ExtCmdLoc *mapPtr,
-			    int eclIndex, int mode, int noCase,
-			    int valueIndex, Tcl_Token *valueTokenPtr,
-			    int numWords, Tcl_Token **bodyToken,
-			    int *bodyLines, int **bodyNext);
-static void		IssueSwitchJumpTable(Tcl_Interp *interp,
-			    CompileEnv *envPtr, ExtCmdLoc *mapPtr,
-			    int eclIndex, int valueIndex,
-			    Tcl_Token *valueTokenPtr, int numWords,
+			    CompileEnv *envPtr, int mode, int noCase,
+			    int valueIndex, int numWords,
 			    Tcl_Token **bodyToken, int *bodyLines,
-			    int **bodyContLines);
+			    int **bodyNext);
+static void		IssueSwitchJumpTable(Tcl_Interp *interp,
+			    CompileEnv *envPtr, int valueIndex,
+			    int numWords, Tcl_Token **bodyToken,
+			    int *bodyLines, int **bodyContLines);
 static int		IssueTryClausesInstructions(Tcl_Interp *interp,
 			    CompileEnv *envPtr, Tcl_Token *bodyToken,
 			    int numHandlers, int *matchCodes,
@@ -1289,13 +1286,16 @@ TclCompileSwitchCmd(
      * but it handles the most common case well enough.
      */
 
+    /* Both methods push the value to match against onto the stack. */
+    SetLineInformation(valueIndex);
+    CompileTokens(envPtr, valueTokenPtr, interp);
+
     if (mode == Switch_Exact) {
-	IssueSwitchJumpTable(interp, envPtr, mapPtr, eclIndex, valueIndex,
-		valueTokenPtr, numWords, bodyToken, bodyLines, bodyContLines);
+	IssueSwitchJumpTable(interp, envPtr, valueIndex, numWords, bodyToken,
+		bodyLines, bodyContLines);
     } else {
-	IssueSwitchChainedTests(interp, envPtr, mapPtr, eclIndex, mode,noCase,
-		valueIndex, valueTokenPtr, numWords, bodyToken, bodyLines,
-		bodyContLines);
+	IssueSwitchChainedTests(interp, envPtr, mode, noCase, valueIndex,
+		numWords, bodyToken, bodyLines, bodyContLines);
     }
     result = TCL_OK;
 
@@ -1333,13 +1333,9 @@ static void
 IssueSwitchChainedTests(
     Tcl_Interp *interp,		/* Context for compiling script bodies. */
     CompileEnv *envPtr,		/* Holds resulting instructions. */
-    ExtCmdLoc *mapPtr,		/* For mapping tokens to their source code
-				 * location. */
-    int eclIndex,
     int mode,			/* Exact, Glob or Regexp */
     int noCase,			/* Case-insensitivity flag. */
     int valueIndex,		/* The value to match against. */
-    Tcl_Token *valueTokenPtr,
     int numBodyTokens,		/* Number of tokens describing things the
 				 * switch can match against and bodies to
 				 * execute when the match succeeds. */
@@ -1364,13 +1360,6 @@ IssueSwitchChainedTests(
     int i;
 
     /*
-     * First, we push the value we're matching against on the stack.
-     */
-
-    SetLineInformation(valueIndex);
-    CompileTokens(envPtr, valueTokenPtr, interp);
-
-    /*
      * Generate a test for each arm.
      */
 
@@ -1595,11 +1584,7 @@ static void
 IssueSwitchJumpTable(
     Tcl_Interp *interp,		/* Context for compiling script bodies. */
     CompileEnv *envPtr,		/* Holds resulting instructions. */
-    ExtCmdLoc *mapPtr,		/* For mapping tokens to their source code
-				 * location. */
-    int eclIndex,
     int valueIndex,		/* The value to match against. */
-    Tcl_Token *valueTokenPtr,
     int numBodyTokens,		/* Number of tokens describing things the
 				 * switch can match against and bodies to
 				 * execute when the match succeeds. */
@@ -1615,13 +1600,6 @@ IssueSwitchJumpTable(
     Tcl_HashEntry *hPtr;
 
     /*
-     * First, we push the value we're matching against on the stack.
-     */
-
-    SetLineInformation(valueIndex);
-    CompileTokens(envPtr, valueTokenPtr, interp);
-
-    /*
      * Compile the switch by using a jump table, which is basically a
      * hashtable that maps from literal values to match against to the offset
      * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump
@@ -2051,8 +2029,7 @@ TclCompileTryCmd(
 	 */
 
 	DefineLineInformation;	/* TIP #280 */
-	SetLineInformation(1);
-	CompileBody(envPtr, bodyToken, interp);
+	BODY(bodyToken, 1);
 	return TCL_OK;
     }
 
@@ -3031,13 +3008,12 @@ TclCompileWhileCmd(
      * Compile the loop body.
      */
 
-    SetLineInformation(2);
     bodyCodeOffset = ExceptionRangeStarts(envPtr, range);
     if (!loopMayEnd) {
 	envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
 	envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
     }
-    CompileBody(envPtr, bodyTokenPtr, interp);
+    BODY(bodyTokenPtr, 2);
     ExceptionRangeEnds(envPtr, range);
     OP(		POP);
 
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 813e056..0bb7cb6 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(
@@ -3059,6 +3049,7 @@ CompileToCompiledCommand(
     int savedNumCmds = envPtr->numCommands;
     int savedStackDepth = envPtr->currStackDepth;
     unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
+    DefineLineInformation;
 
     if (cmdPtr->compileProc == NULL) {
 	return TCL_ERROR;
@@ -3107,12 +3098,27 @@ CompileToCompiledCommand(
     }
 
     /*
+     * Shift the line information arrays to account for different word
+     * index values.
+     */
+
+    mapPtr->loc[eclIndex].line += (depth - 1);
+    mapPtr->loc[eclIndex].next += (depth - 1);
+
+    /*
      * Hand off compilation to the subcommand compiler. At last!
      */
 
     result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr);
 
     /*
+     * Undo the shift. 
+     */
+
+    mapPtr->loc[eclIndex].line -= (depth - 1);
+    mapPtr->loc[eclIndex].next -= (depth - 1);
+
+    /*
      * If our target fails to compile, revert the number of commands and the
      * pointer to the place to issue the next instruction. [Bug 3600328]
      */
@@ -3162,6 +3168,7 @@ CompileToInvokedCommand(
 	    bytes = Tcl_GetStringFromObj(words[i-1], &length);
 	    PushLiteral(envPtr, bytes, length);
 	} else if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	    /* TODO: Check about registering Cmd Literals here */
 	    int literal = TclRegisterNewLiteral(envPtr,
 		    tokPtr[1].start, tokPtr[1].size);
 
@@ -3173,9 +3180,7 @@ CompileToInvokedCommand(
 	    }
 	    TclEmitPush(literal, envPtr);
 	} else {
-	    if (envPtr->clNext) {
-		SetLineInformation(i);
-	    }
+	    SetLineInformation(i);
 	    CompileTokens(envPtr, tokPtr, interp);
 	}
 	tokPtr = TokenAfter(tokPtr);
@@ -3249,12 +3254,10 @@ CompileBasicNArgCommand(
 
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
     for (i=1 ; i<parsePtr->numWords ; i++) {
-	if (envPtr->clNext) {
-	    SetLineInformation(i);
-	}
 	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 	    PushLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size);
 	} else {
+	    SetLineInformation(i);
 	    CompileTokens(envPtr, tokenPtr, interp);
 	}
 	tokenPtr = TokenAfter(tokenPtr);
diff --git a/tests/info.test b/tests/info.test
index ebc853a..afdaaee 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -1962,6 +1962,415 @@ 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}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    set d {a b}
+    dict update d x y {*}{
+	{set res [info frame 0]}
+    }
+    return $res
+}
+test info-33.6 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 1998 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    set d {}
+    dict with d {*}{
+	{set res [info frame 0]}
+    }
+    return $res
+}
+test info-33.7 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2013 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    for {*}{
+	{set res [info frame 0]}
+	{1} {} {break}
+    }
+    return $res
+}
+test info-33.8 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2027 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    for {*}{
+	{} {1} {}
+	{set res [info frame 0]; break}
+    }
+    return $res
+}
+test info-33.9 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2043 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    for {*}{
+	{} {1}
+	{return [info frame 0]}
+	{}
+    }
+}
+test info-33.10 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2058 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    for {*}{
+	{}
+	{[return [info frame 0]]}
+	{} {}
+    }
+}
+test info-33.11 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2073 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    foreach {*}{
+	x
+    } [return [info frame 0]] {}
+}
+test info-33.12 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2088 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    foreach {*}{
+	x y
+	{set res [info frame 0]}
+    } 
+    return $res
+}
+test info-33.13 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2101 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    if {*}{
+	{[return [info frame 0]]}
+	{}
+    } 
+}
+test info-33.14 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2115 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    if 0 {*}{
+	{} else
+	{return [info frame 0]}
+    } 
+}
+test info-33.15 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2130 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    incr {*}{
+	x
+    } [return [info frame 0]]
+}
+test info-33.16 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2144 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    info level {*}{
+    } [return [info frame 0]]
+}
+test info-33.17 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2156 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    string match {*}{
+    } [return [info frame 0]] {}
+}
+test info-33.18 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2168 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    string match {*}{
+	{}
+    } [return [info frame 0]]
+}
+test info-33.19 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2181 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    string length {*}{
+    } [return [info frame 0]]
+}
+test info-33.20 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2193 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    while {*}{
+	{[return [info frame 0]]}
+    } {}
+}
+test info-33.21 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2205 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    switch -- {*}{
+    } [return [info frame 0]] {*}{
+    } x y
+}
+test info-33.22 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2218 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {*}{
+	{set res [info frame 0]}
+    } 
+    return $res
+}
+test info-33.23 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2231 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {*}{
+	{set res [info frame 0]}
+    } finally {}
+    return $res
+}
+test info-33.24 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2245 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {*}{
+	{set res [info frame 0]}
+    } on ok {} {}
+    return $res
+}
+test info-33.25 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2259 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {*}{
+	{set res [info frame 0]}
+    } on ok {} {} finally {}
+    return $res
+}
+test info-33.26 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2273 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    while 1 {*}{
+	{return [info frame 0]}
+    }
+}
+test info-33.27 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2287 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {} finally {*}{
+	{return [info frame 0]}
+    }
+}
+test info-33.28 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2300 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {} on ok {} {} finally {*}{
+	{return [info frame 0]}
+    }
+}
+test info-33.29 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2313 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {} on ok {} {*}{
+	{return [info frame 0]}
+    }
+}
+test info-33.30 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2326 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {} on ok {} {*}{
+	{return [info frame 0]}
+    } finally {}
+}
+test info-33.31 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2339 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    binary format {*}{
+    } [return [info frame 0]]
+}
+test info-33.32 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2352 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    set format format
+    binary $format {*}{
+    } [return [info frame 0]]
+}
+test info-33.33 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2365 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
 unset -nocomplain res
 
 # cleanup