Force named namespaces to be made by TclOO. [154f0982f2]

3 files changed, 34 insertions, 6 deletions

diff --git a/doc/class.n b/doc/class.n
index 1f4c774..22aad24 100644
--- a/doc/class.n
+++ b/doc/class.n
@@ -86,8 +86,11 @@ resolved within the calling context's namespace if not fully qualified),
 passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns
 a successful result) returning the fully qualified name of the created object
 (the result of the constructor is ignored). The name of the instance's
-internal namespace will be \fInsName\fR unless that namespace already exists
-(when an arbitrary name will be chosen instead). If the constructor fails
+internal namespace will be \fInsName\fR;
+.VS
+it is an error if that namespace cannot be created.
+.VE
+If the constructor fails
 (i.e., returns a non-OK result) then the object is destroyed and the error
 message is the result of this method call.
 .SH EXAMPLES
diff --git a/generic/tclOO.c b/generic/tclOO.c
index b314df7..edee7af 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -640,6 +640,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.
+ *
  * ----------------------------------------------------------------------
  */
 
@@ -682,11 +686,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) {
@@ -1888,6 +1897,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 6f8d5b5..55352c0 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1753,6 +1753,19 @@ test oo-11.6.4 {OO: cleanup ReleaseClassContents() where class is mixed into one
     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