summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog10
-rw-r--r--generic/tclCmdIL.c87
-rw-r--r--tests/info.test16
3 files changed, 64 insertions, 49 deletions
diff --git a/ChangeLog b/ChangeLog
index 586941a..e79000e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2008-06-16 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclCmdIL.c (TclInfoFrame): Backport of fix made on the
+ * tests/info.test: head branch :: Moved the code looking up the
+ information for key 'proc' out of the TCL_LOCATION_BC branch to
+ after the switch, this is common to all frame types. Updated the
+ testsuite to match. This was exposed by the 2008-06-08 commit
+ (Miguel), switching uplevel from direct eval to compilation. Fixes
+ [Bug 1987851].
+
2008-06-12 Daniel Steffen <das@users.sourceforge.net>
* unix/Makefile.in: add complete deps on tclDTrace.h.
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index d76b49f..5555c99 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.137 2008/03/14 19:46:17 dgp Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.137.2.1 2008/06/16 20:44:31 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -1125,6 +1125,8 @@ TclInfoFrame(
"eval", "eval", "eval", "precompiled", "source", "proc"
};
Tcl_Obj *tmpObj;
+ Proc *procPtr =
+ framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
/*
* Pull the information and construct the dictionary to return, as list.
@@ -1181,8 +1183,6 @@ TclInfoFrame(
* Execution of bytecode. Talk to the BC engine to fill out the frame.
*/
- Proc *procPtr =
- framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
CmdFrame *fPtr;
fPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
@@ -1216,44 +1216,6 @@ TclInfoFrame(
ADD_PAIR("cmd",
Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len));
-
- if (procPtr != NULL) {
- Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
-
- if (namePtr) {
- /*
- * This is a regular command.
- */
-
- char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr);
- char *nsName = procPtr->cmdPtr->nsPtr->fullName;
-
- ADD_PAIR("proc", Tcl_NewStringObj(nsName, -1));
-
- if (strcmp(nsName, "::") != 0) {
- Tcl_AppendToObj(lv[lc-1], "::", -1);
- }
- Tcl_AppendToObj(lv[lc-1], procName, -1);
- } else if (procPtr->cmdPtr->clientData) {
- ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
- int i;
-
- /*
- * This is a non-standard command. Luckily, it's told us how
- * to render extra information about its frame.
- */
-
- for (i=0 ; i<efiPtr->length ; i++) {
- lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1);
- if (efiPtr->fields[i].proc) {
- lv[lc++] = efiPtr->fields[i].proc(
- efiPtr->fields[i].clientData);
- } else {
- lv[lc++] = efiPtr->fields[i].clientData;
- }
- }
- }
- }
TclStackFree(interp, fPtr);
break;
}
@@ -1282,6 +1244,49 @@ TclInfoFrame(
}
/*
+ * 'proc'. Common to all frame types. Conditional on having an associated
+ * Procedure CallFrame.
+ */
+
+ if (procPtr != NULL) {
+ Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
+
+ if (namePtr) {
+ /*
+ * This is a regular command.
+ */
+
+ char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr);
+ char *nsName = procPtr->cmdPtr->nsPtr->fullName;
+
+ ADD_PAIR("proc", Tcl_NewStringObj(nsName, -1));
+
+ if (strcmp(nsName, "::") != 0) {
+ Tcl_AppendToObj(lv[lc-1], "::", -1);
+ }
+ Tcl_AppendToObj(lv[lc-1], procName, -1);
+ } else if (procPtr->cmdPtr->clientData) {
+ ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
+ int i;
+
+ /*
+ * This is a non-standard command. Luckily, it's told us how to
+ * render extra information about its frame.
+ */
+
+ for (i=0 ; i<efiPtr->length ; i++) {
+ lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1);
+ if (efiPtr->fields[i].proc) {
+ lv[lc++] =
+ efiPtr->fields[i].proc(efiPtr->fields[i].clientData);
+ } else {
+ lv[lc++] = efiPtr->fields[i].clientData;
+ }
+ }
+ }
+ }
+
+ /*
* 'level'. Common to all frame types. Conditional on having an associated
* _visible_ CallFrame.
*/
diff --git a/tests/info.test b/tests/info.test
index a6fa48d..63b8a79 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.47 2007/12/13 15:26:06 dgp Exp $
+# RCS: @(#) $Id: info.test,v 1.47.2.1 2008/06/16 20:44:32 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -748,13 +748,13 @@ test info-22.2 {info frame, bad level absolute} {!singleTestInterp} {
} {bad level "9"}
test info-22.3 {info frame, current, relative} {
info frame 0
-} {type eval line 2 cmd {info frame 0}}
+} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
test info-22.4 {info frame, current, relative, nested} {
set res [info frame 0]
-} {type eval line 2 cmd {info frame 0}}
+} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
test info-22.5 {info frame, current, absolute} {!singleTestInterp} {
reduce [info frame 7]
-} {type eval line 2 cmd {info frame 7}}
+} {type eval line 2 cmd {info frame 7} proc ::tcltest::RunTest}
test info-22.6 {info frame, global, relative} {!singleTestInterp} {
reduce [info frame -6]
} {type source line 758 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0}
@@ -787,14 +787,14 @@ test info-23.3 {eval'd info frame, literal} {
eval {
info frame 0
}
-} {type eval line 2 cmd {info frame 0}}
+} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.4 {eval'd info frame, semi-dynamic} {
eval info frame 0
-} {type eval line 1 cmd {info frame 0}}
+} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.5 {eval'd info frame, dynamic} {
set script {info frame 0}
eval $script
-} {type eval line 1 cmd {info frame 0}}
+} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.6 {eval'd info frame, trace} {knownBug !singleTestInterp} {
set script {etrace}
join [eval $script] \n
@@ -982,7 +982,7 @@ test info-31.5 {for, script in variable} {
test info-31.6 {eval, script in variable} {
eval $body
set res
-} {type eval line 3 cmd {info frame 0}}
+} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
# -------------------------------------------------------------------------
generated by cgit v0.12 at 2024-11-14 15:56:13 (GMT)