summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclBasic.c20
-rw-r--r--tests/trace.test12
3 files changed, 29 insertions, 9 deletions
diff --git a/ChangeLog b/ChangeLog
index ede14f2..d6a70bd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2002-07-17 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclBasic.c (CallCommandTraces): delete traces now
+ receive the FQ old name of the command.
+ [Bug 582532] (Don Porter)
+
2002-07-18 Vince Darley <vincentdarley@users.sourceforge.net>
* tests/ioUtil.test: added constraints to 1.4,2.4 so they
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b60a6c3..86730ab 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.63 2002/07/16 01:12:50 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.64 2002/07/18 13:37:45 msofer Exp $
*/
#include "tclInt.h"
@@ -2518,6 +2518,8 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
register CommandTrace *tracePtr;
ActiveCommandTrace active;
char *result;
+ Tcl_Obj *oldNamePtr = NULL;
+
if (cmdPtr->flags & CMD_TRACE_ACTIVE) {
/*
* While a rename trace is active, we will not process any more
@@ -2554,8 +2556,11 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
}
cmdPtr->flags |= tracePtr->flags;
if (oldName == NULL) {
- oldName = Tcl_GetCommandName((Tcl_Interp *) iPtr,
- (Tcl_Command) cmdPtr);
+ TclNewObj(oldNamePtr);
+ Tcl_IncrRefCount(oldNamePtr);
+ Tcl_GetCommandFullName((Tcl_Interp *) iPtr,
+ (Tcl_Command) cmdPtr, oldNamePtr);
+ oldName = TclGetString(oldNamePtr);
}
Tcl_Preserve((ClientData) tracePtr);
(*tracePtr->traceProc)(tracePtr->clientData,
@@ -2565,6 +2570,15 @@ CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)
}
/*
+ * If a new object was created to hold the full oldName,
+ * free it now.
+ */
+
+ if (oldNamePtr != NULL) {
+ TclDecrRefCount(oldNamePtr);
+ }
+
+ /*
* Restore the variable's flags, remove the record of our active
* traces, and then return.
*/
diff --git a/tests/trace.test b/tests/trace.test
index 7f7213b..2229b69 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.19 2002/06/17 22:52:51 hobbs Exp $
+# RCS: @(#) $Id: trace.test,v 1.20 2002/07/18 13:37:46 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -1254,7 +1254,7 @@ test trace-20.1 {trace add command (delete option)} {
trace add command foo delete traceCommand
rename foo ""
set info
-} {foo {} delete}
+} {::foo {} delete}
test trace-20.2 {trace add command delete doesn't trace recreated commands} {
set info {}
proc foo {} {}
@@ -1271,7 +1271,7 @@ test trace-20.3 {trace add command implicit delete} {
trace add command foo delete traceCommand
proc foo {} {}
set info
-} {foo {} delete}
+} {::foo {} delete}
test trace-20.3.1 {trace add command delete trace info} {
proc foo {} {}
trace info command foo
@@ -1287,7 +1287,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 +1303,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 +1323,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