diff options
| author | dkf <dkf@noemail.net> | 2010-01-28 10:25:03 (GMT) |
|---|---|---|
| committer | dkf <dkf@noemail.net> | 2010-01-28 10:25:03 (GMT) |
| commit | 2b4dad9a4ecca00563cd4c957fffaf8e1662dec6 (patch) | |
| tree | 5b3c218fe68fcb9e058cf40de629094ec43f22d5 /generic/tclOOBasic.c | |
| parent | 02a01f02b98fdfec22412cfd500756cfd354b7ee (diff) | |
| download | tcl-2b4dad9a4ecca00563cd4c957fffaf8e1662dec6.zip tcl-2b4dad9a4ecca00563cd4c957fffaf8e1662dec6.tar.gz tcl-2b4dad9a4ecca00563cd4c957fffaf8e1662dec6.tar.bz2 | |
Improvements to destructor handling.
Stop crashes from odd destruction routes.
FossilOrigin-Name: ca70f094be1873138d5f9fb8b0d0787e451c3a23
Diffstat (limited to 'generic/tclOOBasic.c')
| -rw-r--r-- | generic/tclOOBasic.c | 18 |
1 files changed, 16 insertions, 2 deletions
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index e064928..eedbf5a 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.20 2009/11/27 06:33:40 dkf Exp $ + * RCS: @(#) $Id: tclOOBasic.c,v 1.21 2010/01/28 10:25:05 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -259,14 +259,28 @@ TclOO_Object_Destroy( int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { + Object *oPtr = (Object *) Tcl_ObjectContextObject(context); + int result = TCL_OK; + if (objc != Tcl_ObjectContextSkippedArgs(context)) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; } + if (!(oPtr->flags & DESTRUCTOR_CALLED)) { + CallContext *contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR); + + oPtr->flags |= DESTRUCTOR_CALLED; + if (contextPtr != NULL) { + contextPtr->callPtr->flags |= DESTRUCTOR; + contextPtr->skip = 0; + result = TclOOInvokeContext(interp, contextPtr, 0, NULL); + TclOODeleteContext(contextPtr); + } + } Tcl_DeleteCommandFromToken(interp, Tcl_GetObjectCommand(Tcl_ObjectContextObject(context))); - return TCL_OK; + return result; } /* |