From d52ef74d40e9ea437e953e3f7d5ea021324b3b9e Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 15 May 2015 13:54:52 +0000
Subject: [9dd1bd7a74] Ensure that [self] returns a sensible value in a
 destructor even when construction didn't complete.

---
 generic/tclOO.c |  9 +++++++--
 tests/oo.test   | 25 +++++++++++++++++++++++++
 2 files changed, 32 insertions(+), 2 deletions(-)

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 77e668b..e2ef1ae 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1675,10 +1675,13 @@ Tcl_NewObjectInstance(
 
 		/*
 		 * Take care to not delete a deleted object; that would be
-		 * bad. [Bug 2903011]
+		 * bad. [Bug 2903011] Also take care to make sure that we have
+		 * the name of the command before we delete it. [Bug
+		 * 9dd1bd7a74]
 		 */
 
 		if (!Deleted(oPtr)) {
+		    (void) TclOOObjectName(interp, oPtr);
 		    Tcl_DeleteCommandFromToken(interp, oPtr->command);
 		}
 		return NULL;
@@ -1821,10 +1824,12 @@ FinalizeAlloc(
 
 	/*
 	 * Take care to not delete a deleted object; that would be bad. [Bug
-	 * 2903011]
+	 * 2903011] Also take care to make sure that we have the name of the
+	 * command before we delete it. [Bug 9dd1bd7a74]
 	 */
 
 	if (!Deleted(oPtr)) {
+	    (void) TclOOObjectName(interp, oPtr);
 	    Tcl_DeleteCommandFromToken(interp, oPtr->command);
 	}
 	DelRef(oPtr);
diff --git a/tests/oo.test b/tests/oo.test
index 5fa760b..22e6cfb 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -416,6 +416,31 @@ test oo-2.8 {construction, method calls and ensembles - Bug 3514761} -setup {
 } -returnCodes error -cleanup {
     namespace delete k
 } -result {wrong # args: should be "k next j"}
+test oo-2.9 {construction failures and self creation} -setup {
+    set ::result {}
+    oo::class create Root
+} -body {
+    oo::class create A {
+	superclass Root
+	constructor {} {
+	    lappend ::result "in A"
+	    error "failure in A"
+	}
+	destructor {lappend ::result [self]}
+    }
+    oo::class create B {
+	superclass Root
+	constructor {} {
+	    lappend ::result "in B [self]"
+	    error "failure in B"
+	}
+	destructor {lappend ::result [self]}
+    }
+    lappend ::result [catch {A create a} msg] $msg
+    lappend ::result [catch {B create b} msg] $msg
+} -cleanup {
+    Root destroy
+} -result {{in A} ::a 1 {failure in A} {in B ::b} ::b 1 {failure in B}}
 
 test oo-3.1 {basic test of OO functionality: destructor} -setup {
     # This is a bit complex because it needs to run in a sub-interp as we're
-- 
cgit v0.12