From 654dc20b4af9b37825f7faffaa0e714dad02ce92 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 15 Jul 2013 19:09:59 +0000 Subject: Possible improvement in light of [86ceb4e2b6]. --- library/tm.tcl | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/library/tm.tcl b/library/tm.tcl index d2af4f5..955e84d 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -238,6 +238,15 @@ proc ::tcl::tm::UnknownHandler {original name args} { continue } + if {[string length [package ifneeded $pkgname $pkgversion]]} { + # There's already a provide script registered for + # this version of this package. Since all units of + # code claiming to be the same version of the same + # package ought to be identical, just stick with + # the one we already have. + continue + } + # We have found a candidate, generate a "provide script" # for it, and remember it. Note that we are using ::list # to do this; locally [list] means something else without -- cgit v0.12 From 4bba36ca59c3760f9e2a593e8135aa6f8352919e Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 5 Sep 2013 15:47:29 +0000 Subject: Use ne instead of [string length] for less shimmer risk. --- library/tm.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/tm.tcl b/library/tm.tcl index 955e84d..55efda6 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -238,7 +238,7 @@ proc ::tcl::tm::UnknownHandler {original name args} { continue } - if {[string length [package ifneeded $pkgname $pkgversion]]} { + if {[package ifneeded $pkgname $pkgversion] ne {}} { # There's already a provide script registered for # this version of this package. Since all units of # code claiming to be the same version of the same -- cgit v0.12 From 76023565adb6e64816efbf4cae39b1c5d2ab725a Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 5 Sep 2013 17:21:41 +0000 Subject: Partial revert of [a16752c252] bug fix to stop crashes in buggy tclcompiler. --- generic/tclBasic.c | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 314b5fc..c3ab871 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1967,7 +1967,8 @@ Tcl_CreateCommand( * * Side effects: * If a command named "cmdName" already exists for interp, it is - * first deleted. Then the new command is created from the arguments. + * first deleted. Then the new command is created from the arguments. + * [***] (See below for exception). * * 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 @@ -2034,8 +2035,27 @@ Tcl_CreateObjCommand( if (!isNew) { cmdPtr = Tcl_GetHashValue(hPtr); + /* Command already exists. */ + + /* + * [***] This is wrong. See Tcl Bug a16752c252. + * However, this buggy behavior is kept under particular + * circumstances to accommodate deployed binaries of the + * "tclcompiler" program. http://sourceforge.net/projects/tclpro/ + * that crash if the bug is fixed. + */ + + if (cmdPtr->objProc == TclInvokeStringCommand + && cmdPtr->clientData == clientData + && cmdPtr->deleteData == clientData + && cmdPtr->deleteProc == deleteProc) { + cmdPtr->objProc = proc; + cmdPtr->objClientData = clientData; + return (Tcl_Command) cmdPtr; + } + /* - * Command already exists; delete it. Be careful to preserve any + * Otherwise, we delete the old command. 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. -- cgit v0.12