diff options
author | dgp <dgp@users.sourceforge.net> | 2015-12-22 18:27:23 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2015-12-22 18:27:23 (GMT) |
commit | 1614457e38312b8180cd9ef843bffcc6a45a14cc (patch) | |
tree | 407dbdaa8a9c3510bded84f507f44e82a466c534 | |
parent | 9766a76000f4b621c0fa1ef9f7ad6d41d0f36a74 (diff) | |
download | tcl-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.c | 29 | ||||
-rw-r--r-- | tests/oo.test | 7 |
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 |