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