diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclOOBasic.c | 9 | ||||
| -rw-r--r-- | tests/oo.test | 18 |
3 files changed, 29 insertions, 4 deletions
@@ -1,3 +1,9 @@ +2010-02-02 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclOOBasic.c (TclOO_Object_Destroy): [Bug 2944404]: Do not + crash when a destructor deletes the object that is executing that + destructor. + 2010-02-01 Donal K. Fellows <dkf@users.sf.net> * generic/tclVar.c (Tcl_ArrayObjCmd): [Bug 2939073]: Stop the [array diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 193ca93..2c42fe9 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOOBasic.c,v 1.22 2010/01/28 13:57:48 dkf Exp $ + * RCS: @(#) $Id: tclOOBasic.c,v 1.23 2010/02/02 09:13:45 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -267,6 +267,7 @@ TclOO_Object_Destroy( NULL); return TCL_ERROR; } + AddRef(oPtr); if (!(oPtr->flags & DESTRUCTOR_CALLED)) { CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL); @@ -280,8 +281,10 @@ TclOO_Object_Destroy( TclOODeleteContext(contextPtr); } } - Tcl_DeleteCommandFromToken(interp, - Tcl_GetObjectCommand(Tcl_ObjectContextObject(context))); + if (oPtr->command) { + Tcl_DeleteCommandFromToken(interp, oPtr->command); + } + DelRef(oPtr); return result; } diff --git a/tests/oo.test b/tests/oo.test index 6fdc344..d831b3d 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: oo.test,v 1.35 2010/01/28 10:25:05 dkf Exp $ +# RCS: @(#) $Id: oo.test,v 1.36 2010/02/02 09:13:45 dkf Exp $ package require -exact TclOO 0.6.2 ;# Must match value in generic/tclOO.h if {[lsearch [namespace children] ::tcltest] == -1} { @@ -440,6 +440,22 @@ test oo-3.8 {basic test of OO functionality: errors in destructor} -setup { list [namespace delete [info object namespace [cls create obj]]] \ [update idletasks] $result [info commands obj] } -result {{} {} foo {}} +test oo-3.9 {Bug 2944404: deleting the object in the destructor} -setup { + oo::class create cls + set result {} +} -body { + oo::define cls { + destructor { + lappend ::result in destructor + [self] destroy + } + } + # This used to crash + [cls new] destroy + return $result +} -cleanup { + cls destroy +} -result {in destructor} test oo-4.1 {basic test of OO functionality: export} { set o [oo::object new] |