summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-09-07 22:19:49 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-09-07 22:19:49 (GMT)
commit22ba33d2b43194f8bc84aff36d0ed84a710cd8ff (patch)
treea56b6f6a4b8b6550b9a7165580aa865e65931752
parent133768540d48de8f9bf0638fd9983178588bd18a (diff)
parent53c609c3aa4042d00194dc6d3d2bea553ad9d605 (diff)
downloadtcl-22ba33d2b43194f8bc84aff36d0ed84a710cd8ff.zip
tcl-22ba33d2b43194f8bc84aff36d0ed84a710cd8ff.tar.gz
tcl-22ba33d2b43194f8bc84aff36d0ed84a710cd8ff.tar.bz2
[86ceb4e2b6] Improve reaction when multiple *tm files purport to offer the
same version of the same package. Prefer the file that comes first on the tm path. Makes TCL*_TM_PATH variables more useful. Thanks to Gustaf Neumann for the suggestion. [a16752c252] Revise (partially revert) bug fix to stop crashes in buggy tclcompiler.
-rw-r--r--generic/tclBasic.c24
-rw-r--r--library/tm.tcl9
2 files changed, 31 insertions, 2 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a10a11a..a41351e 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2175,7 +2175,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
@@ -2242,8 +2243,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.
diff --git a/library/tm.tcl b/library/tm.tcl
index d2af4f5..55efda6 100644
--- a/library/tm.tcl
+++ b/library/tm.tcl
@@ -238,6 +238,15 @@ proc ::tcl::tm::UnknownHandler {original name args} {
continue
}
+ 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
+ # 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