summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclOO.c196
-rw-r--r--generic/tclOODefineCmds.c10
-rw-r--r--tests/oo.test8
3 files changed, 91 insertions, 123 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c
index a129a52..587e46d 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -397,39 +397,28 @@ InitFoundation(
fPtr->objectCls = AllocClass(interp,
AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
- /* Corresponding TclOODecrRefCount in KillFoudation */
- AddRef(fPtr->objectCls->thisPtr);
-
- /* This is why it is unnecessary in this routine to replace the
- * incremented reference count of fPtr->objectCls that was swallowed by
- * fakeObject. */
- fPtr->objectCls->superclasses.num = 0;
- ckfree(fPtr->objectCls->superclasses.list);
- fPtr->objectCls->superclasses.list = NULL;
-
- /* special initialization for the primordial objects */
- fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
- fPtr->objectCls->flags |= ROOT_OBJECT;
-
fPtr->classCls = AllocClass(interp,
AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
- /* Corresponding TclOODecrRefCount in KillFoudation */
- AddRef(fPtr->classCls->thisPtr);
-
- /*
- * Increment reference counts for each reference because these
- * relationships can be dynamically changed.
- *
- * Corresponding TclOODecrRefCount for all incremented refcounts is in
- * KillFoundation.
- */
/* Rewire bootstrapped objects. */
fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
- AddRef(fPtr->objectCls->thisPtr->selfCls->thisPtr);
-
fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
+
+ AddRef(fPtr->objectCls->thisPtr);
+ AddRef(fPtr->classCls->thisPtr);
AddRef(fPtr->classCls->thisPtr->selfCls->thisPtr);
+ AddRef(fPtr->objectCls->thisPtr->selfCls->thisPtr);
+
+ /* special initialization for the primordial objects */
+ fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
+ fPtr->objectCls->flags |= ROOT_OBJECT;
+
+ /* This is why it is unnecessary in this routine to make up for the
+ * incremented reference count of fPtr->objectCls that was sallwed by
+ * fakeObject. */
+ fPtr->objectCls->superclasses.num = 0;
+ ckfree(fPtr->objectCls->superclasses.list);
+ fPtr->objectCls->superclasses.list = NULL;
fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
fPtr->classCls->flags |= ROOT_CLASS;
@@ -563,20 +552,20 @@ KillFoundation(
{
Foundation *fPtr = GetFoundation(interp);
+ /*
+ * Crude mechanism to avoid leaking the Object struct of the
+ * foundation components oo::object and oo::class
+ *
+ * Should probably be replaced with something more elegantly designed.
+ */
+ while (TclOODecrRefCount(fPtr->objectCls->thisPtr) == 0) {};
+ while (TclOODecrRefCount(fPtr->classCls->thisPtr) == 0) {};
+
TclDecrRefCount(fPtr->unknownMethodNameObj);
TclDecrRefCount(fPtr->constructorName);
TclDecrRefCount(fPtr->destructorName);
TclDecrRefCount(fPtr->clonedName);
TclDecrRefCount(fPtr->defineName);
- if (fPtr->objectCls->thisPtr->selfCls != NULL) {
- TclOODecrRefCount(fPtr->objectCls->thisPtr->selfCls->thisPtr);
- }
- if (fPtr->classCls->thisPtr->selfCls != NULL) {
- TclOODecrRefCount(fPtr->classCls->thisPtr->selfCls->thisPtr);
- }
- TclOODecrRefCount(fPtr->objectCls->thisPtr);
- TclOODecrRefCount(fPtr->classCls->thisPtr);
-
ckfree(fPtr);
}
@@ -660,8 +649,6 @@ AllocObject(
Tcl_ResetResult(interp);
}
- ((Namespace *)oPtr->namespacePtr)->refCount++;
-
/*
* Make the namespace know about the helper commands. This grants access
* to the [self] and [next] commands.
@@ -833,9 +820,10 @@ ObjectRenamedTrace(
/*
* ----------------------------------------------------------------------
*
- * DeleteDescendants --
+ * ReleaseClassContents --
*
- * Delete all descendants of a particular class.
+ * Tear down the special class data structure, including deleting all
+ * dependent classes and objects.
*
* ----------------------------------------------------------------------
*/
@@ -847,79 +835,50 @@ DeleteDescendants(
{
Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr;
Object *instancePtr;
+ int i;
/*
* Squelch classes that this class has been mixed into.
*/
- if (clsPtr->mixinSubs.num > 0) {
- while (clsPtr->mixinSubs.num > 0) {
- mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num-1];
- /* This condition also covers the case where mixinSubclassPtr ==
- * clsPtr
- */
- if (!Deleted(mixinSubclassPtr->thisPtr)) {
- Tcl_DeleteCommandFromToken(interp,
- mixinSubclassPtr->thisPtr->command);
- }
- TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
+ FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
+ /* This condition also covers the case where mixinSubclassPtr ==
+ * clsPtr
+ */
+ if (!Deleted(mixinSubclassPtr->thisPtr)) {
+ Tcl_DeleteCommandFromToken(interp,
+ mixinSubclassPtr->thisPtr->command);
}
- }
- if (clsPtr->mixinSubs.size > 0) {
- ckfree(clsPtr->mixinSubs.list);
- clsPtr->mixinSubs.size = 0;
+ i -= TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
+ TclOODecrRefCount(mixinSubclassPtr->thisPtr);
}
/*
* Squelch subclasses of this class.
*/
- if (clsPtr->subclasses.num > 0) {
- while (clsPtr->subclasses.num > 0) {
- subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1];
- if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) {
- Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
- }
- TclOORemoveFromSubclasses(subclassPtr, clsPtr);
+ FOREACH(subclassPtr, clsPtr->subclasses) {
+ if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) {
+ Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
}
- }
- if (clsPtr->subclasses.size > 0) {
- ckfree(clsPtr->subclasses.list);
- clsPtr->subclasses.list = NULL;
- clsPtr->subclasses.size = 0;
+ i -= TclOORemoveFromSubclasses(subclassPtr, clsPtr);
+ TclOODecrRefCount(subclassPtr->thisPtr);
}
/*
* Squelch instances of this class (includes objects we're mixed into).
*/
- if (clsPtr->instances.num > 0) {
- while (clsPtr->instances.num > 0) {
- instancePtr = clsPtr->instances.list[clsPtr->instances.num-1];
+ if (!IsRootClass(oPtr)) {
+ FOREACH(instancePtr, clsPtr->instances) {
/* This condition also covers the case where instancePtr == oPtr */
if (!Deleted(instancePtr) && !IsRoot(instancePtr)) {
Tcl_DeleteCommandFromToken(interp, instancePtr->command);
}
- TclOORemoveFromInstances(instancePtr, clsPtr);
+ i -= TclOORemoveFromInstances(instancePtr, clsPtr);
}
}
- if (clsPtr->instances.size > 0) {
- ckfree(clsPtr->instances.list);
- clsPtr->instances.list = NULL;
- clsPtr->instances.size = 0;
- }
}
-
-/*
- * ----------------------------------------------------------------------
- *
- * ReleaseClassContents --
- *
- * Tear down the special class data structure, including deleting all
- * dependent classes and objects.
- *
- * ----------------------------------------------------------------------
- */
static void
ReleaseClassContents(
@@ -989,6 +948,21 @@ ReleaseClassContents(
}
/*
+ * Squelch our instances.
+ */
+
+ if (clsPtr->instances.num) {
+ Object *oPtr;
+
+ FOREACH(oPtr, clsPtr->instances) {
+ TclOODecrRefCount(oPtr);
+ }
+ ckfree(clsPtr->instances.list);
+ clsPtr->instances.list = NULL;
+ clsPtr->instances.num = 0;
+ }
+
+ /*
* Squelch our metadata.
*/
@@ -1004,21 +978,11 @@ ReleaseClassContents(
clsPtr->metadataPtr = NULL;
}
- if (clsPtr->mixins.num) {
- FOREACH(tmpClsPtr, clsPtr->mixins) {
- TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr);
- }
- ckfree(clsPtr->mixins.list);
+ FOREACH(tmpClsPtr, clsPtr->mixins) {
+ TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr);
}
-
- if (clsPtr->superclasses.num > 0) {
- FOREACH(tmpClsPtr, clsPtr->superclasses) {
- TclOORemoveFromSubclasses(clsPtr, tmpClsPtr);
- TclOODecrRefCount(tmpClsPtr->thisPtr);
- }
- ckfree(clsPtr->superclasses.list);
- clsPtr->superclasses.num = 0;
- clsPtr->superclasses.list = NULL;
+ FOREACH(tmpClsPtr, clsPtr->superclasses) {
+ TclOORemoveFromSubclasses(clsPtr, tmpClsPtr);
}
FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
@@ -1146,10 +1110,10 @@ ObjectNamespaceDeleted(
/* To do: Should this be protected with a * !IsRoot() condition? */
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
- if (oPtr->mixins.num > 0) {
- FOREACH(mixinPtr, oPtr->mixins) {
- TclOORemoveFromInstances(oPtr, mixinPtr);
- }
+ FOREACH(mixinPtr, oPtr->mixins) {
+ i -= TclOORemoveFromInstances(oPtr, mixinPtr);
+ }
+ if (i) {
ckfree(oPtr->mixins.list);
}
@@ -1221,9 +1185,7 @@ ObjectNamespaceDeleted(
* Delete the object structure itself.
*/
- TclNsDecrRefCount((Namespace *)oPtr->namespacePtr);
oPtr->namespacePtr = NULL;
- TclOODecrRefCount(oPtr->selfCls->thisPtr);
oPtr->selfCls = NULL;
TclOODecrRefCount(oPtr);
return;
@@ -1242,7 +1204,13 @@ ObjectNamespaceDeleted(
*/
int TclOODecrRefCount(Object *oPtr) {
if (oPtr->refCount-- <= 1) {
+ Class *clsPtr = oPtr->classPtr;
if (oPtr->classPtr != NULL) {
+ ckfree(clsPtr->superclasses.list);
+ ckfree(clsPtr->subclasses.list);
+ ckfree(clsPtr->instances.list);
+ ckfree(clsPtr->mixinSubs.list);
+ ckfree(clsPtr->mixins.list);
ckfree(oPtr->classPtr);
}
ckfree(oPtr);
@@ -1282,6 +1250,9 @@ TclOORemoveFromInstances(
{
int i, res = 0;
Object *instPtr;
+ if (Deleted(clsPtr->thisPtr)) {
+ return res;
+ }
FOREACH(instPtr, clsPtr->instances) {
if (oPtr == instPtr) {
@@ -1344,6 +1315,9 @@ TclOORemoveFromSubclasses(
{
int i, res = 0;
Class *subclsPtr;
+ if (Deleted(superPtr->thisPtr)) {
+ return res;
+ }
FOREACH(subclsPtr, superPtr->subclasses) {
if (subPtr == subclsPtr) {
@@ -1408,6 +1382,10 @@ TclOORemoveFromMixinSubs(
int i, res = 0;
Class *subclsPtr;
+ if (Deleted(superPtr->thisPtr)) {
+ return res;
+ }
+
FOREACH(subclsPtr, superPtr->mixinSubs) {
if (subPtr == subclsPtr) {
RemoveItem(Class, superPtr->mixinSubs, i);
@@ -1700,7 +1678,6 @@ TclNewObjectInstanceCommon(
oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr);
oPtr->selfCls = classPtr;
- AddRef(classPtr->thisPtr);
TclOOAddToInstances(oPtr, classPtr);
/*
* Check to see if we're really creating a class. If so, allocate the
@@ -1937,11 +1914,6 @@ Tcl_CopyObjectInstance(
cls2Ptr->superclasses.num = clsPtr->superclasses.num;
FOREACH(superPtr, cls2Ptr->superclasses) {
TclOOAddToSubclasses(cls2Ptr, superPtr);
-
- /* For the new item in cls2Ptr->superclasses that memcpy just
- * created
- */
- AddRef(superPtr->thisPtr);
}
/*
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index dfd2acf..d05d899 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -1125,13 +1125,12 @@ TclOODefineClassObjCmd(
*/
if (oPtr->selfCls != clsPtr) {
-
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
- TclOODecrRefCount(oPtr->selfCls->thisPtr);
+
+ /* Reference count already incremented 3 lines up. */
oPtr->selfCls = clsPtr;
- AddRef(oPtr->selfCls->thisPtr);
- TclOOAddToInstances(oPtr, oPtr->selfCls);
+ TclOOAddToInstances(oPtr, oPtr->selfCls);
if (oPtr->classPtr != NULL) {
BumpGlobalEpoch(interp, oPtr->classPtr);
} else {
@@ -2152,6 +2151,7 @@ ClassSuperSet(
superclasses[0] = oPtr->fPtr->objectCls;
}
superc = 1;
+ /* Corresponding TclOODecrRefCount is near the end of this function */
AddRef(superclasses[0]->thisPtr);
} else {
for (i=0 ; i<superc ; i++) {
@@ -2204,6 +2204,8 @@ ClassSuperSet(
oPtr->classPtr->superclasses.num = superc;
FOREACH(superPtr, oPtr->classPtr->superclasses) {
TclOOAddToSubclasses(oPtr->classPtr, superPtr);
+ /* To account for the AddRef() earlier in this function */
+ TclOODecrRefCount(superPtr->thisPtr);
}
BumpGlobalEpoch(interp, oPtr->classPtr);
diff --git a/tests/oo.test b/tests/oo.test
index a698bac..9cf3133 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -57,13 +57,7 @@ test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
foo destroy
}
} -constraints memory -result 0
-test oo-0.5.1 {testing object foundation cleanup} memory {
- leaktest {
- interp create foo
- interp delete foo
- }
-} 0
-test oo-0.5.2 {testing literal leak on interp delete} memory {
+test oo-0.5 {testing literal leak on interp delete} memory {
leaktest {
interp create foo
foo eval {oo::object new}
generated by cgit v0.12 at 2024-10-22 21:39:48 (GMT)