From 3389b582e203479619e667d55c99b74f1bb1942e Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 23 May 2024 13:18:18 +0000
Subject: [154f0982f2] Update createWithNamespace to error on namespace
 creation failure

---
 generic/tclOO.c | 20 ++++++++++++++++----
 tests/oo.test   | 13 +++++++++++++
 2 files changed, 29 insertions(+), 4 deletions(-)

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 86c4087..1580abd 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -610,6 +610,10 @@ KillFoundation(
  *	call TclOOAddToSubclasses() to add it to the right class's list of
  *	subclasses.
  *
+ * Returns:
+ *	Pointer to the object structure created, or NULL if a specific
+ *	namespace was asked for but couldn't be created.
+ *
  * ----------------------------------------------------------------------
  */
 
@@ -652,11 +656,16 @@ AllocObject(
 
     if (nsNameStr != NULL) {
 	oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr, NULL);
-	if (oPtr->namespacePtr != NULL) {
-	    creationEpoch = ++fPtr->tsdPtr->nsCount;
-	    goto configNamespace;
+	if (oPtr->namespacePtr == NULL) {
+	    /*
+	     * Couldn't make the specific namespace. Report as an error.
+	     * [Bug 154f0982f2]
+	     */
+	    ckfree(oPtr);
+	    return NULL;
 	}
-	Tcl_ResetResult(interp);
+	creationEpoch = ++fPtr->tsdPtr->nsCount;
+	goto configNamespace;
     }
 
     while (1) {
@@ -1783,6 +1792,9 @@ TclNewObjectInstanceCommon(
      */
 
     oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr);
+    if (oPtr == NULL) {
+	return NULL;
+    }
     oPtr->selfCls = classPtr;
     AddRef(classPtr->thisPtr);
     TclOOAddToInstances(oPtr, classPtr);
diff --git a/tests/oo.test b/tests/oo.test
index 366f4d3..c940011 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1685,6 +1685,19 @@ test oo-11.6.4 {
     rename obj1 {}
 }
 
+test oo-11.7 {Bug 154f0982f2: createWithNamespace and an existing namespace} -setup {
+    oo::class create Aclass {
+	self export createWithNamespace
+	method ns {} {namespace current}
+    }
+} -body {
+    namespace eval test_oo117 {variable name [namespace current]}
+    list [Aclass createWithNamespace aInstance $test_oo117::name] [aInstance ns]
+} -returnCodes error -cleanup {
+    Aclass destroy
+    catch {namespace delete test_oo117}
+} -result {can't create namespace "::test_oo117": already exists}
+
 test oo-12.1 {OO: filters} {
     oo::class create Aclass
     Aclass create Aobject
-- 
cgit v0.12