diff options
| -rw-r--r-- | doc/trace.n | 4 | ||||
| -rw-r--r-- | generic/tclBasic.c | 29 | ||||
| -rw-r--r-- | tests/trace.test | 27 |
3 files changed, 44 insertions, 16 deletions
diff --git a/doc/trace.n b/doc/trace.n index 0e2654b..892237e 100644 --- a/doc/trace.n +++ b/doc/trace.n @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: trace.n,v 1.11 2002/07/16 22:27:35 dgp Exp $ +'\" RCS: @(#) $Id: trace.n,v 1.12 2003/02/03 20:16:52 kennykb Exp $ '\" .so man.macros .TH trace n "8.4" Tcl "Tcl Built-In Commands" @@ -66,6 +66,8 @@ is complete. Recursive renaming or deleting will not cause further traces of the same type to be evaluated, so a delete trace which itself deletes the command, or a rename trace which itself renames the command will not cause further trace evaluations to occur. +Both \fIoldName\fR and \fInewName\fR are fully qualified with any namespace(s) +in which they appear. .RE .TP \fBtrace add execution\fR \fIname ops command\fR diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 6702240..e7b0aa0 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -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: tclBasic.c,v 1.71 2003/01/17 14:19:40 vincentdarley Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.72 2003/02/03 20:16:52 kennykb Exp $ */ #include "tclInt.h" @@ -1918,6 +1918,8 @@ TclRenameCommand(interp, oldName, newName) Command *cmdPtr; Tcl_HashEntry *hPtr, *oldHPtr; int new, result; + Tcl_Obj* oldFullName; + Tcl_DString newFullName; /* * Find the existing command. An error is returned if cmdName can't @@ -1934,6 +1936,9 @@ TclRenameCommand(interp, oldName, newName) return TCL_ERROR; } cmdNsPtr = cmdPtr->nsPtr; + oldFullName = Tcl_NewObj(); + Tcl_IncrRefCount( oldFullName ); + Tcl_GetCommandFullName( interp, cmd, oldFullName ); /* * If the new command name is NULL or empty, delete the command. Do this @@ -1968,7 +1973,6 @@ TclRenameCommand(interp, oldName, newName) return TCL_ERROR; } - /* * Warning: any changes done in the code here are likely * to be needed in Tcl_HideCommand() code too. @@ -2006,9 +2010,26 @@ TclRenameCommand(interp, oldName, newName) * Therefore increment the reference count for cmdPtr so that * it's Command structure is freed only towards the end of this * function by calling TclCleanupCommand. + * + * The trace procedure needs to get a fully qualified name for + * old and new commands [Tcl bug #651271], or else there's no way + * for the trace procedure to get the namespace from which the old + * command is being renamed! */ + + Tcl_DStringInit( &newFullName ); + Tcl_DStringAppend( &newFullName, newNsPtr->fullName, -1 ); + if ( newNsPtr != iPtr->globalNsPtr ) { + Tcl_DStringAppend( &newFullName, "::", 2 ); + } + Tcl_DStringAppend( &newFullName, newTail, -1 ); cmdPtr->refCount++; - CallCommandTraces(iPtr,cmdPtr,oldName,newName,TCL_TRACE_RENAME); + CallCommandTraces( iPtr, cmdPtr, + Tcl_GetString( oldFullName ), + Tcl_DStringValue( &newFullName ), + TCL_TRACE_RENAME); + Tcl_DecrRefCount( oldFullName ); + Tcl_DStringFree( &newFullName ); /* * The new command name is okay, so remove the command from its @@ -2305,7 +2326,7 @@ Tcl_GetCommandFullName(interp, command, objPtr) if (cmdPtr->hPtr != NULL) { name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); Tcl_AppendToObj(objPtr, name, -1); - } + } } } diff --git a/tests/trace.test b/tests/trace.test index 52a6c4e..2da4a9f 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: trace.test,v 1.25 2003/01/17 14:19:55 vincentdarley Exp $ +# RCS: @(#) $Id: trace.test,v 1.26 2003/02/03 20:16:54 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1181,7 +1181,7 @@ test trace-19.1 {trace add command (rename option)} { trace add command foo rename traceCommand rename foo bar set info -} {foo bar rename} +} {::foo ::bar rename} test trace-19.2 {traces stick with renamed commands} { proc foo {} {} catch {rename bar {}} @@ -1189,7 +1189,7 @@ test trace-19.2 {traces stick with renamed commands} { rename foo bar rename bar foo set info -} {bar foo rename} +} {::bar ::foo rename} test trace-19.2.1 {trace add command rename trace exists} { proc foo {} {} trace add command foo rename traceCommand @@ -1223,19 +1223,19 @@ test trace-19.6 {trace add command rename in namespace} { trace add command tc::tcfoo rename traceCommand rename tc::tcfoo tc::tcbar set info -} {tc::tcfoo tc::tcbar rename} +} {::tc::tcfoo ::tc::tcbar rename} test trace-19.7 {trace add command rename in namespace back again} { rename tc::tcbar tc::tcfoo set info -} {tc::tcbar tc::tcfoo rename} +} {::tc::tcbar ::tc::tcfoo rename} test trace-19.8 {trace add command rename in namespace to out of namespace} { rename tc::tcfoo tcbar set info -} {tc::tcfoo tcbar rename} +} {::tc::tcfoo ::tcbar rename} test trace-19.9 {trace add command rename back into namespace} { rename tcbar tc::tcfoo set info -} {tcbar tc::tcfoo rename} +} {::tcbar ::tc::tcfoo rename} test trace-19.10 {trace add command failed rename doesn't trigger trace} { set info {} proc foo {} {} @@ -1246,6 +1246,11 @@ test trace-19.10 {trace add command failed rename doesn't trigger trace} { } {} catch {rename foo {}} catch {rename bar {}} +test trace-19.11 {trace add command qualifies when renamed in namespace} { + set info {} + namespace eval tc {rename tcfoo tcbar} + set info +} {::tc::tcfoo ::tc::tcbar rename} # Make sure it exists again proc foo {} {} @@ -1287,7 +1292,7 @@ test trace-20.4 {trace add command rename followed by delete} { set info $infotemp unset infotemp set info -} {{foo bar rename} {::bar {} delete}} +} {{::foo ::bar rename} {::bar {} delete}} catch {rename foo {}} catch {rename bar {}} @@ -1303,7 +1308,7 @@ test trace-20.5 {trace add command rename and delete} { set info $infotemp unset infotemp set info -} {{foo bar rename} {::bar {} delete}} +} {{::foo ::bar rename} {::bar {} delete}} test trace-20.6 {trace add command rename and delete in subinterp} { set tc [interp create] @@ -1323,7 +1328,7 @@ test trace-20.6 {trace add command rename and delete in subinterp} { set info [$tc eval [list set info]] interp delete $tc set info -} {{foo bar rename} {::bar {} delete}} +} {{::foo ::bar rename} {::bar {} delete}} # I'd like it if this test could give 'foo {} d' as a result, # but interp deletion means there is no interp to evaluate @@ -1356,7 +1361,7 @@ test trace-20.8 {trace delete while trace is active} { trace add command foo {rename delete} [list traceDelete foo] rename foo bar list [set info] [trace info command bar] -} {{foo bar rename} {}} +} {{::foo ::bar rename} {}} test trace-20.9 {rename trace deletes command} { set info {} |