From ec43fe476600ee215c4012baea54bdb62f394cd2 Mon Sep 17 00:00:00 2001 From: andreas_kupries Date: Mon, 16 Jun 2008 19:59:03 +0000 Subject: * 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]. --- ChangeLog | 9 ++++++ generic/tclCmdIL.c | 88 +++++++++++++++++++++++++++++------------------------- tests/info.test | 16 +++++----- 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 + * 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 + * 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 ; ilength ; 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 ; ilength ; 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} # ------------------------------------------------------------------------- -- cgit v0.12