summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-08-14 17:02:41 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-08-14 17:02:41 (GMT)
commit2916d083d8e80db13d25190cdc1534aad0cf67ad (patch)
treeb4aed5d5734f1eb0636b86f7aacb63c84282073a
parent420294d3ed2faf23f5b57ed32e1bf869c4f71b8f (diff)
downloadtcl-2916d083d8e80db13d25190cdc1534aad0cf67ad.zip
tcl-2916d083d8e80db13d25190cdc1534aad0cf67ad.tar.gz
tcl-2916d083d8e80db13d25190cdc1534aad0cf67ad.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 4f24515..8ab3acb 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1966,12 +1966,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
@@ -2039,21 +2035,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.
@@ -2188,8 +2170,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 9ef7805..5b51baa 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1545,14 +1545,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 bd14578..cd90b55 100644
--- a/tests/rename.test
+++ b/tests/rename.test
@@ -135,6 +135,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.