summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-08-14 17:07:00 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-08-14 17:07:00 (GMT)
commit2b3657769b1d0b9ae6e10113b1d3c038b4967899 (patch)
treed95768f57f7d31e60d09a96c40dde315f8bf76f0
parent34f83405d31dbe1b95f1608c91f483f9170c4d23 (diff)
parent2916d083d8e80db13d25190cdc1534aad0cf67ad (diff)
downloadtcl-2b3657769b1d0b9ae6e10113b1d3c038b4967899.zip
tcl-2b3657769b1d0b9ae6e10113b1d3c038b4967899.tar.gz
tcl-2b3657769b1d0b9ae6e10113b1d3c038b4967899.tar.bz2
[a16752c252] Correct failure to call cmd deletion callbacks.
-rw-r--r--generic/tclBasic.c28
-rw-r--r--generic/tclTest.c6
-rw-r--r--tests/rename.test7
3 files changed, 15 insertions, 26 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index f852b44..dd6a40b 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2172,12 +2172,8 @@ Tcl_CreateCommand(
* future calls to Tcl_GetCommandName.
*
* Side effects:
- * If no command named "cmdName" already exists for interp, one is
- * created. Otherwise, if a command does exist, then if the object-based
- * Tcl_ObjCmdProc is TclInvokeStringCommand, we assume Tcl_CreateCommand
- * was called previously for the same command and just set its
- * Tcl_ObjCmdProc to the argument "proc"; otherwise, we delete the old
- * command.
+ * If a command named "cmdName" already exists for interp, it is
+ * first deleted. Then the new command is created from the arguments.
*
* In the future, during bytecode evaluation when "cmdName" is seen as
* the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
@@ -2245,21 +2241,7 @@ Tcl_CreateObjCommand(
cmdPtr = Tcl_GetHashValue(hPtr);
/*
- * Command already exists. If its object-based Tcl_ObjCmdProc is
- * TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the
- * argument "proc". Otherwise, we delete the old command.
- */
-
- if (cmdPtr->objProc == TclInvokeStringCommand) {
- cmdPtr->objProc = proc;
- cmdPtr->objClientData = clientData;
- cmdPtr->deleteProc = deleteProc;
- cmdPtr->deleteData = clientData;
- return (Tcl_Command) cmdPtr;
- }
-
- /*
- * Otherwise, we delete the old command. Be careful to preserve any
+ * Command already exists; delete it. Be careful to preserve any
* existing import links so we can restore them down below. That way,
* you can redefine a command and its import status will remain
* intact.
@@ -2407,8 +2389,8 @@ TclInvokeStringCommand(
* A standard Tcl string result value.
*
* Side effects:
- * Besides those side effects of the called Tcl_CmdProc,
- * TclInvokeStringCommand allocates and frees storage.
+ * Besides those side effects of the called Tcl_ObjCmdProc,
+ * TclInvokeObjectCommand allocates and frees storage.
*
*----------------------------------------------------------------------
*/
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 27ee89c..96973d7 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1555,14 +1555,14 @@ DelCallbackProc(
*
* TestdelCmd --
*
- * This procedure implements the "testdcall" command. It is used
- * to test Tcl_CallWhenDeleted.
+ * This procedure implements the "testdel" command. It is used
+ * to test calling of command deletion callbacks.
*
* Results:
* A standard Tcl result.
*
* Side effects:
- * Creates and deletes interpreters.
+ * Creates a command.
*
*----------------------------------------------------------------------
*/
diff --git a/tests/rename.test b/tests/rename.test
index 1fa0441..ebf5425 100644
--- a/tests/rename.test
+++ b/tests/rename.test
@@ -140,6 +140,13 @@ test rename-4.7 {reentrancy issues with command deletion and renaming} testdel {
if {[info exists env(value)]} {
unset env(value)
}
+test rename-4.8 {Bug a16752c252} testdel {
+ set x broken
+ testdel {} foo {set x ok}
+ proc foo args {}
+ rename foo {}
+ return -level 0 $x[unset x]
+} ok
# Save the unknown procedure which is modified by the following test.