* generic/tclCmdIL.c (TclInfoFrame): Moved the code looking up the

	* tests/info.test: 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].

3 files changed, 64 insertions, 49 deletions

diff --git a/ChangeLog b/ChangeLog
index ec79e0b..417e7ad 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,14 @@
 2008-06-16  Andreas Kupries  <andreask@activestate.com>
 
+	* generic/tclCmdIL.c (TclInfoFrame): Moved the code looking up the
+	* tests/info.test: 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-16  Andreas Kupries  <andreask@activestate.com>
+
 	* tests/ioTrans.test (iortrans-11.*): Fixed same issue as for
 	iortrans.tf-11.*, cleanup of temp file, making this a followup to
 	the entry on 2008-06-10 by myself.
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index f18a14a..296c3f4 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.139 2008/05/30 22:54:27 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.140 2008/06/16 19:59:03 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -1126,6 +1126,9 @@ TclInfoFrame(
     };
     Tcl_Obj *tmpObj;
 
+    Proc *procPtr =
+	framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
+
    /*
      * Pull the information and construct the dictionary to return, as list.
      * Regarding use of the CmdFrame fields see tclInt.h, and its definition.
@@ -1181,8 +1184,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 +1217,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 +1245,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 b6b708c..54a548a 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.48 2008/05/31 11:42:20 dkf Exp $
+# RCS: @(#) $Id: info.test,v 1.49 2008/06/16 19:59:04 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}
 
 # -------------------------------------------------------------------------