Ensure that destroying an object in a constructor doesn't crash. [Bug 2903011]

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);