summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2015-12-22 18:27:23 (GMT)
committerdgp <dgp@users.sourceforge.net>2015-12-22 18:27:23 (GMT)
commit1614457e38312b8180cd9ef843bffcc6a45a14cc (patch)
tree407dbdaa8a9c3510bded84f507f44e82a466c534
parent9766a76000f4b621c0fa1ef9f7ad6d41d0f36a74 (diff)
downloadtcl-1614457e38312b8180cd9ef843bffcc6a45a14cc.zip
tcl-1614457e38312b8180cd9ef843bffcc6a45a14cc.tar.gz
tcl-1614457e38312b8180cd9ef843bffcc6a45a14cc.tar.bz2
[593baa032c] Possible fix (with test) for segfault in superclass teardown.
-rw-r--r--generic/tclOO.c29
-rw-r--r--tests/oo.test7
2 files changed, 27 insertions, 9 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 5fca220..f2e0ca9 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -58,6 +58,7 @@ static const struct {
static Class * AllocClass(Tcl_Interp *interp, Object *useThisObj);
static Object * AllocObject(Tcl_Interp *interp, const char *nameStr,
const char *nsNameStr);
+static void ClearSuperclasses(Class *clsPtr);
static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
Method *mPtr, Tcl_Obj *namePtr,
Method **newMPtrPtr);
@@ -905,6 +906,20 @@ ObjectRenamedTrace(
*/
static void
+ClearSuperclasses(
+ Class *clsPtr)
+{
+ int i;
+ Class *superPtr;
+
+ FOREACH(superPtr, clsPtr->superclasses) {
+ TclOORemoveFromSubclasses(clsPtr, superPtr);
+ }
+ ckfree(clsPtr->superclasses.list);
+ clsPtr->superclasses.num = 0;
+}
+
+static void
ReleaseClassContents(
Tcl_Interp *interp, /* The interpreter containing the class. */
Object *oPtr) /* The object representing the class. */
@@ -999,6 +1014,9 @@ ReleaseClassContents(
if (!Deleted(subclassPtr->thisPtr)) {
Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
}
+ if (subclassPtr->superclasses.num) {
+ ClearSuperclasses(subclassPtr);
+ }
DelRef(subclassPtr->thisPtr);
DelRef(subclassPtr);
}
@@ -1195,7 +1213,6 @@ ObjectNamespaceDeleted(
}
if (clsPtr != NULL) {
- Class *superPtr;
Tcl_ObjectMetadataType *metadataTypePtr;
ClientData value;
@@ -1224,14 +1241,8 @@ ObjectNamespaceDeleted(
ckfree(clsPtr->mixins.list);
clsPtr->mixins.num = 0;
}
- FOREACH(superPtr, clsPtr->superclasses) {
- if (!Deleted(superPtr->thisPtr)) {
- TclOORemoveFromSubclasses(clsPtr, superPtr);
- }
- }
- if (i) {
- ckfree(clsPtr->superclasses.list);
- clsPtr->superclasses.num = 0;
+ if (clsPtr->superclasses.num) {
+ ClearSuperclasses(clsPtr);
}
if (clsPtr->subclasses.list) {
ckfree(clsPtr->subclasses.list);
diff --git a/tests/oo.test b/tests/oo.test
index 2112f10..ca5c7f9 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3671,6 +3671,13 @@ test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
unset -nocomplain result
fruitMetaclass destroy
} -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear}
+test oo-35.3 {Bug 593baa032c: superclass list teardown} {
+ # Bug makes this crash, especially with mem-debugging on
+ oo::class create B {}
+ oo::class create D {superclass B}
+ namespace eval [info object namespace D] [list [namespace which B] destroy]
+} {}
+
cleanupTests
return