summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2006-09-22 18:31:53 (GMT)
committerandreas_kupries <akupries@shaw.ca>2006-09-22 18:31:53 (GMT)
commit84710c0562a0091891deddb2f101cd44798db8c2 (patch)
tree08b6aa1d5f4a7947b8e891a3d7a7639a7df32d15 /generic
parentffcc33c7062c747cb8341a4b2405e8043dd02733 (diff)
downloadtcl-84710c0562a0091891deddb2f101cd44798db8c2.zip
tcl-84710c0562a0091891deddb2f101cd44798db8c2.tar.gz
tcl-84710c0562a0091891deddb2f101cd44798db8c2.tar.bz2
* generic/tclPkg.c (Tcl_PkgRequireEx): Changes handling of the
return information from 'Tcl_PkgRequireProc'. Keep the interpreter result empty. Backport of fix for problem found while testing #268 under 8.5. More details in the comments.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclPkg.c61
1 files changed, 59 insertions, 2 deletions
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index de87a0b..052992a 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclPkg.c,v 1.9.2.5 2006/09/22 01:26:23 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclPkg.c,v 1.9.2.6 2006/09/22 18:31:54 andreas_kupries Exp $
*
* TIP #268.
* Heavily rewritten to handle the extend version numbers, and extended
@@ -80,6 +80,8 @@ static void AddRequirementsToDString(Tcl_DString* dstring,
int reqc, Tcl_Obj *CONST reqv[]);
static Package * FindPackage(Tcl_Interp *interp, CONST char *name);
static Tcl_Obj* ExactRequirement(CONST char* version);
+static void VersionCleanupProc(ClientData clientData,
+ Tcl_Interp *interp);
#endif
/*
@@ -344,7 +346,32 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
return NULL;
}
- return Tcl_GetString (Tcl_GetObjResult (interp));
+ /* This function returns the version string explictly, and leaves the
+ * interpreter result empty. However "Tcl_PkgRequireProc" above returned
+ * the version through the interpreter result. Simply resetting the result
+ * now potentially deletes the string (obj), and the pointer to its string
+ * rep we have, as our result, may be dangling due to this. Our solution
+ * is to remember the object in interp associated data, with a proper
+ * reference count, and then reset the result. Now pointers will not
+ * dangle. It will be a leak however if nothing is done. So the next time
+ * we come through here we delete the object remembered by this call, as
+ * we can then be sure that there is no pointer to its string around
+ * anymore. Beyond that we have a deletion function which cleans up the last
+ * remembered object which was not cleaned up directly, here.
+ */
+
+ ov = (Tcl_Obj*) Tcl_GetAssocData (interp, "tcl/Tcl_PkgRequireEx", NULL);
+ if (ov != NULL) {
+ Tcl_DecrRefCount (ov);
+ }
+
+ ov = Tcl_GetObjResult (interp);
+ Tcl_IncrRefCount (ov);
+ Tcl_SetAssocData(interp, "tcl/Tcl_PkgRequireEx", VersionCleanupProc,
+ (ClientData) ov);
+ Tcl_ResetResult (interp);
+
+ return Tcl_GetString (ov);
}
int
@@ -2332,6 +2359,36 @@ ExactRequirement(version)
}
/*
+ *----------------------------------------------------------------------
+ *
+ * VersionCleanupProc --
+ *
+ * This function is called to delete the last remember package version
+ * string for an interpreter when the interpreter is deleted. It gets
+ * invoked via the Tcl AssocData mechanism.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage for the version object for interp get deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+VersionCleanupProc (
+ ClientData clientData, /* Pointer to remembered version string object
+ * for interp. */
+ Tcl_Interp *interp) /* Interpreter that is being deleted. */
+{
+ Tcl_Obj* ov = (Tcl_Obj*) clientData;
+ if (ov != NULL) {
+ Tcl_DecrRefCount (ov);
+ }
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4