* generic/tclBasic.c: Changed [trace add command] so that 'rename'

callbacks get fully qualified names of the command. [Bug
651271]. ***POTENTIAL INCOMPATIBILITY***
* tests/trace.test: Modified the test cases for [trace add
command] to expect fully qualified names on the 'rename'
callbacks. Added a case for renaming a proc within a namespace.
* doc/trace.n: Added language about use of fully qualified names
in trace callbacks.

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 {}