summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--doc/trace.n4
-rw-r--r--generic/tclBasic.c29
-rw-r--r--tests/trace.test27
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 {}