diff options
Diffstat (limited to 'generic/tclOO.c')
| -rw-r--r-- | generic/tclOO.c | 48 |
1 files changed, 44 insertions, 4 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c index a4e8cce..242496f 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOO.c,v 1.25 2009/11/18 21:59:51 nijtmans Exp $ + * RCS: @(#) $Id: tclOO.c,v 1.26 2009/11/24 12:00:08 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -1334,7 +1334,7 @@ Tcl_NewObjectInstance( TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL); if (contextPtr != NULL) { - int result; + int result, flags; Tcl_InterpState state; AddRef(oPtr); @@ -1343,11 +1343,32 @@ Tcl_NewObjectInstance( contextPtr->skip = skip; result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, objc, objv); + flags = oPtr->flags; + + /* + * It's an error if the object was whacked in the constructor. + * Force this if it isn't already an error (don't want to lose + * errors by accident...) [Bug 2903011] + */ + + if (result != TCL_ERROR && (flags & OBJECT_DELETED)) { + Tcl_SetResult(interp, "object deleted in constructor", + TCL_STATIC); + result = TCL_ERROR; + } TclOODeleteContext(contextPtr); DelRef(oPtr); if (result != TCL_OK) { Tcl_DiscardInterpState(state); - Tcl_DeleteCommandFromToken(interp, oPtr->command); + + /* + * Take care to not delete a deleted object; that would be + * bad. [Bug 2903011] + */ + + if (!(flags & OBJECT_DELETED)) { + Tcl_DeleteCommandFromToken(interp, oPtr->command); + } return NULL; } Tcl_RestoreInterpState(interp, state); @@ -1458,12 +1479,31 @@ FinalizeAlloc( Object *oPtr = data[1]; Tcl_InterpState state = data[2]; Tcl_Object *objectPtr = data[3]; + int flags = oPtr->flags; + + /* + * It's an error if the object was whacked in the constructor. Force this + * if it isn't already an error (don't want to lose errors by accident...) + * [Bug 2903011] + */ + if (result != TCL_ERROR && (flags & OBJECT_DELETED)) { + Tcl_SetResult(interp, "object deleted in constructor", TCL_STATIC); + result = TCL_ERROR; + } TclOODeleteContext(contextPtr); DelRef(oPtr); if (result != TCL_OK) { Tcl_DiscardInterpState(state); - Tcl_DeleteCommandFromToken(interp, oPtr->command); + + /* + * Take care to not delete a deleted object; that would be bad. [Bug + * 2903011] + */ + + if (!(flags & OBJECT_DELETED)) { + Tcl_DeleteCommandFromToken(interp, oPtr->command); + } return TCL_ERROR; } Tcl_RestoreInterpState(interp, state); |