Attachment "651271.patch" to
ticket [651271ffff]
added by
kennykb
2003-02-02 09:36:35.
Index: doc/trace.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/trace.n,v
retrieving revision 1.11
diff -u -r1.11 trace.n
--- doc/trace.n 16 Jul 2002 22:27:35 -0000 1.11
+++ doc/trace.n 2 Feb 2003 02:23:47 -0000
@@ -66,6 +66,8 @@
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
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.71
diff -u -r1.71 tclBasic.c
--- generic/tclBasic.c 17 Jan 2003 14:19:40 -0000 1.71
+++ generic/tclBasic.c 2 Feb 2003 02:23:50 -0000
@@ -1918,6 +1918,8 @@
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 @@
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 @@
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 @@
* 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 @@
if (cmdPtr->hPtr != NULL) {
name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
Tcl_AppendToObj(objPtr, name, -1);
- }
+ }
}
}
Index: tests/trace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/trace.test,v
retrieving revision 1.25
diff -u -r1.25 trace.test
--- tests/trace.test 17 Jan 2003 14:19:55 -0000 1.25
+++ tests/trace.test 2 Feb 2003 02:23:51 -0000
@@ -1181,7 +1181,7 @@
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 @@
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 @@
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 @@
} {}
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 @@
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 @@
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 @@
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 @@
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 {}
