summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-07-11 04:07:39 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-07-11 04:07:39 (GMT)
commit879263daeede5edbf8536cab6eba690b9a7cad4a (patch)
treedd314bf04dc89630af6697fd178f26dde3d2cad7
parentfceaf9997d7c45ba92c6c61930207823446f1e50 (diff)
parentac62d0c4970dfe3fa03f4fa77c05d23943a20671 (diff)
downloadtcl-879263daeede5edbf8536cab6eba690b9a7cad4a.zip
tcl-879263daeede5edbf8536cab6eba690b9a7cad4a.tar.gz
tcl-879263daeede5edbf8536cab6eba690b9a7cad4a.tar.bz2
Add a test for each call to SetLineInformation() demonstrating the need
for it to be there. Fixed bugs revealed by the new tests. What's still missing are more tests demonstrating the need for other SetLineInformation() calls that are not there yet. ;)
-rw-r--r--generic/tclCompCmds.c6
-rw-r--r--generic/tclCompCmdsSZ.c58
-rw-r--r--generic/tclEnsemble.c19
-rw-r--r--tests/info.test409
4 files changed, 431 insertions, 61 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index fddf152..a56727d 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 855dd8f..0497e8a 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,
@@ -1286,13 +1283,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;
@@ -1330,13 +1330,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. */
@@ -1361,13 +1357,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.
*/
@@ -1592,11 +1581,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. */
@@ -1612,13 +1597,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
@@ -2048,8 +2026,7 @@ TclCompileTryCmd(
*/
DefineLineInformation; /* TIP #280 */
- SetLineInformation(1);
- CompileBody(envPtr, bodyToken, interp);
+ BODY(bodyToken, 1);
return TCL_OK;
}
@@ -3028,13 +3005,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 a718d0e..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(
@@ -3178,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);
@@ -3189,9 +3180,7 @@ CompileToInvokedCommand(
}
TclEmitPush(literal, envPtr);
} else {
- if (envPtr->clNext) {
- SetLineInformation(i);
- }
+ SetLineInformation(i);
CompileTokens(envPtr, tokPtr, interp);
}
tokPtr = TokenAfter(tokPtr);
@@ -3265,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