summaryrefslogtreecommitdiffstats
path: root/generic/tclOOBasic.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclOOBasic.c')
-rw-r--r--generic/tclOOBasic.c18
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;
}
/*