diff options
author | dgp <dgp@users.sourceforge.net> | 2013-08-14 17:07:00 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2013-08-14 17:07:00 (GMT) |
commit | 2b3657769b1d0b9ae6e10113b1d3c038b4967899 (patch) | |
tree | d95768f57f7d31e60d09a96c40dde315f8bf76f0 | |
parent | 34f83405d31dbe1b95f1608c91f483f9170c4d23 (diff) | |
parent | 2916d083d8e80db13d25190cdc1534aad0cf67ad (diff) | |
download | tcl-2b3657769b1d0b9ae6e10113b1d3c038b4967899.zip tcl-2b3657769b1d0b9ae6e10113b1d3c038b4967899.tar.gz tcl-2b3657769b1d0b9ae6e10113b1d3c038b4967899.tar.bz2 |
[a16752c252] Correct failure to call cmd deletion callbacks.
-rw-r--r-- | generic/tclBasic.c | 28 | ||||
-rw-r--r-- | generic/tclTest.c | 6 | ||||
-rw-r--r-- | tests/rename.test | 7 |
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. |