From 3c942c50d91bc8ea58c64065922babf397943e8f Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Fri, 17 Nov 2017 22:30:06 +0000
Subject: Fix [16fe1b5807]: namespace ensemble command named ":" is mistakenly
 given the empty string as its name.

---
 generic/tclBasic.c    | 105 +++++++++++++++++++++++++------------
 generic/tclEnsemble.c | 140 +++++++++++++++++++++++++++++++-------------------
 generic/tclInt.h      |  26 ++++++++++
 generic/tclNamesp.c   |  31 ++++++++++-
 generic/tclProc.c     |  20 +-------
 tests/namespace.test  |  18 +++++--
 6 files changed, 231 insertions(+), 109 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index fe29db0..334febc 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2098,13 +2098,13 @@ Tcl_CreateCommand(
 
         hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
 
-        if (isNew || deleted) {
+	if (isNew || deleted) {
 	    /*
 	     * isNew - No conflict with existing command.
 	     * deleted - We've already deleted a conflicting command
 	     */
 	    break;
-        }
+	}
 
 	/* An existing command conflicts. Try to delete it.. */
 	cmdPtr = Tcl_GetHashValue(hPtr);
@@ -2245,64 +2245,81 @@ Tcl_CreateObjCommand(
 				 * name. */
     ClientData clientData,	/* Arbitrary value to pass to object
 				 * function. */
-    Tcl_CmdDeleteProc *deleteProc)
+    Tcl_CmdDeleteProc *deleteProc
 				/* If not NULL, gives a function to call when
 				 * this command is deleted. */
+)
 {
     Interp *iPtr = (Interp *) interp;
-    ImportRef *oldRefPtr = NULL;
     Namespace *nsPtr;
-    Command *cmdPtr;
-    Tcl_HashEntry *hPtr;
     const char *tail;
-    int isNew = 0, deleted = 0;
-    ImportedCmdData *dataPtr;
 
     if (iPtr->flags & DELETED) {
 	/*
 	 * The interpreter is being deleted. Don't create any new commands;
 	 * it's not safe to muck with the interpreter anymore.
 	 */
-
 	return (Tcl_Command) NULL;
     }
 
     /*
+     * Determine where the command should reside. If its name contains
+     * namespace qualifiers, we put it in the specified namespace;
+     * otherwise, we always put it in the global namespace.
+     */
+
+    if (strstr(cmdName, "::") != NULL) {
+	Namespace *dummy1, *dummy2;
+
+	TclGetNamespaceForQualName(interp, cmdName, NULL,
+	    TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
+	if ((nsPtr == NULL) || (tail == NULL)) {
+	    return (Tcl_Command) NULL;
+	}
+    } else {
+	nsPtr = iPtr->globalNsPtr;
+	tail = cmdName;
+    }
+
+    return tclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr,
+	proc, clientData, deleteProc);
+}
+
+Tcl_Command tclCreateObjCommandInNs (
+    Tcl_Interp *interp,
+    const char *cmdName,	/* Name of command, without any namespace components */
+    Tcl_Namespace *namespace,   /* The namespace to create the command in */
+    Tcl_ObjCmdProc *proc,	/* Object-based function to associate with
+				 * name. */
+    ClientData clientData,	/* Arbitrary value to pass to object
+				 * function. */
+    Tcl_CmdDeleteProc *deleteProc
+				/* If not NULL, gives a function to call when
+				 * this command is deleted. */
+) {
+    int deleted = 0, isNew = 0;
+    Command *cmdPtr;
+    ImportRef *oldRefPtr = NULL;
+    ImportedCmdData *dataPtr;
+    Tcl_HashEntry *hPtr;
+    Namespace *nsPtr = (Namespace *) namespace;
+    /*
      * If the command name we seek to create already exists, we need to
      * delete that first.  That can be tricky in the presence of traces.
      * Loop until we no longer find an existing command in the way, or
      * until we've deleted one command and that didn't finish the job.
      */
-
     while (1) {
-        /*
-         * Determine where the command should reside. If its name contains
-         * namespace qualifiers, we put it in the specified namespace;
-	 * otherwise, we always put it in the global namespace.
-         */
-
-        if (strstr(cmdName, "::") != NULL) {
-	    Namespace *dummy1, *dummy2;
-
-	    TclGetNamespaceForQualName(interp, cmdName, NULL,
-		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
-	    if ((nsPtr == NULL) || (tail == NULL)) {
-	        return (Tcl_Command) NULL;
-	    }
-        } else {
-	    nsPtr = iPtr->globalNsPtr;
-	    tail = cmdName;
-        }
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
 
-        hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
-
-        if (isNew || deleted) {
+	if (isNew || deleted) {
 	    /*
 	     * isNew - No conflict with existing command.
 	     * deleted - We've already deleted a conflicting command
 	     */
 	    break;
-        }
+	}
+
 
 	/* An existing command conflicts. Try to delete it.. */
 	cmdPtr = Tcl_GetHashValue(hPtr);
@@ -2336,7 +2353,13 @@ Tcl_CreateObjCommand(
 	    cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
 	}
 
+	/* Make sure namespace doesn't get deallocated. */
+	cmdPtr->nsPtr->refCount++;
+
 	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+	nsPtr = (Namespace *) TclEnsureNamespace(interp,
+	    (Tcl_Namespace *)cmdPtr->nsPtr);
+	TclNsDecrRefCount(cmdPtr->nsPtr);
 
 	if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
 	    oldRefPtr = cmdPtr->importRefPtr;
@@ -2345,7 +2368,6 @@ Tcl_CreateObjCommand(
 	TclCleanupCommandMacro(cmdPtr);
 	deleted = 1;
     }
-
     if (!isNew) {
 	/*
 	 * If the deletion callback recreated the command, just throw away
@@ -2367,7 +2389,7 @@ Tcl_CreateObjCommand(
 	 * commands.
 	 */
 
-	TclInvalidateCmdLiteral(interp, tail, nsPtr);
+	TclInvalidateCmdLiteral(interp, cmdName, nsPtr);
 
 	/*
 	 * The list of command exported from the namespace might have changed.
@@ -8187,6 +8209,21 @@ Tcl_NRCreateCommand(
     cmdPtr->nreProc = nreProc;
     return (Tcl_Command) cmdPtr;
 }
+
+Tcl_Command tclNRCreateCommandInNs (
+    Tcl_Interp *interp,
+    const char *cmdName,
+    Tcl_Namespace *nsPtr,
+    Tcl_ObjCmdProc *proc,
+    Tcl_ObjCmdProc *nreProc,
+    ClientData clientData,
+    Tcl_CmdDeleteProc *deleteProc) {
+    Command *cmdPtr = (Command *)
+	tclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
+
+    cmdPtr->nreProc = nreProc;
+    return (Tcl_Command) cmdPtr;
+}
 
 /****************************************************************************
  * Stuff for the public api
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index f3e8187..28802b0 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -146,10 +146,12 @@ TclNamespaceEnsembleCmd(
     Tcl_Obj *const objv[])
 {
     Tcl_Namespace *namespacePtr;
-    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
+    	*foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
     Tcl_Command token;
     Tcl_DictSearch search;
     Tcl_Obj *listObj;
+    const char *simpleName;
     int index, done;
 
     if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
@@ -195,13 +197,8 @@ TclNamespaceEnsembleCmd(
 	objv += 2;
 	objc -= 2;
 
-	/*
-	 * Work out what name to use for the command to create. If supplied,
-	 * it is either fully specified or relative to the current namespace.
-	 * If not supplied, it is exactly the name of the current namespace.
-	 */
-
-	name = nsPtr->fullName;
+	name = nsPtr->name;
+	cxtPtr = (Namespace *) nsPtr->parentPtr;
 
 	/*
 	 * Parse the option list, applying type checks as we go. Note that we
@@ -221,6 +218,7 @@ TclNamespaceEnsembleCmd(
 	    switch ((enum EnsCreateOpts) index) {
 	    case CRT_CMD:
 		name = TclGetString(objv[1]);
+		cxtPtr = nsPtr;
 		continue;
 	    case CRT_SUBCMDS:
 		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
@@ -337,6 +335,10 @@ TclNamespaceEnsembleCmd(
 	    }
 	}
 
+	TclGetNamespaceForQualName(interp, name, cxtPtr,
+	TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr, &actualCxtPtr,
+	&simpleName);
+
 	/*
 	 * Create the ensemble. Note that this might delete another ensemble
 	 * linked to the same namespace, so we must be careful. However, we
@@ -344,8 +346,9 @@ TclNamespaceEnsembleCmd(
 	 * we've created it (and after any deletions have occurred.)
 	 */
 
-	token = Tcl_CreateEnsemble(interp, name, NULL,
-		(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
+	token = TclCreateEnsembleInNs(interp, simpleName,
+	     (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
+	     (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
 	Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
 	Tcl_SetEnsembleMappingDict(interp, token, mapObj);
 	Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
@@ -636,48 +639,38 @@ TclNamespaceEnsembleCmd(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_CreateEnsemble --
+ * TclCreateEnsembleInNs --
  *
- *	Create a simple ensemble attached to the given namespace.
- *
- * Results:
- *	The token for the command created.
- *
- * Side effects:
- *	The ensemble is created and marked for compilation.
+ *	Like Tcl_CreateEnsemble, but additionally accepts as an argument the
+ *	name of the namespace to create the command in.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Command
-Tcl_CreateEnsemble(
-    Tcl_Interp *interp,
-    const char *name,
-    Tcl_Namespace *namespacePtr,
-    int flags)
+TclCreateEnsembleInNs(
+    Tcl_Interp *interp, 
+			
+    const char *name,   /* Simple name of command to create (no */
+			/* namespace components). */
+    Tcl_Namespace       /* Name of namespace to create the command in. */ 
+    *nameNsPtr,	
+    Tcl_Namespace
+    *ensembleNsPtr,	/* Name of the namespace for the ensemble. */
+    int flags
+    )
 {
-    Namespace *nsPtr = (Namespace *) namespacePtr;
-    EnsembleConfig *ensemblePtr = ckalloc(sizeof(EnsembleConfig));
-    Tcl_Obj *nameObj = NULL;
-
-    if (nsPtr == NULL) {
-	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    }
-
-    /*
-     * Make the name of the ensemble into a fully qualified name. This might
-     * allocate a temporary object.
-     */
+    Namespace *nsPtr = (Namespace *) ensembleNsPtr;
+    EnsembleConfig *ensemblePtr;
+    Tcl_Command token;
 
-    if (!(name[0] == ':' && name[1] == ':')) {
-	nameObj = NewNsObj((Tcl_Namespace *) nsPtr);
-	if (nsPtr->parentPtr == NULL) {
-	    Tcl_AppendStringsToObj(nameObj, name, NULL);
-	} else {
-	    Tcl_AppendStringsToObj(nameObj, "::", name, NULL);
-	}
-	Tcl_IncrRefCount(nameObj);
-	name = TclGetString(nameObj);
+    ensemblePtr = ckalloc(sizeof(EnsembleConfig));
+    token = tclNRCreateCommandInNs(interp, name,
+	(Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
+	NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
+    if (token == NULL) {
+	ckfree(ensemblePtr);
+	return NULL;
     }
 
     ensemblePtr->nsPtr = nsPtr;
@@ -690,9 +683,7 @@ Tcl_CreateEnsemble(
     ensemblePtr->numParameters = 0;
     ensemblePtr->parameterList = NULL;
     ensemblePtr->unknownHandler = NULL;
-    ensemblePtr->token = Tcl_NRCreateCommand(interp, name,
-	    NsEnsembleImplementationCmd, NsEnsembleImplementationCmdNR,
-	    ensemblePtr, DeleteEnsembleConfig);
+    ensemblePtr->token = token;
     ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
     nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;
 
@@ -709,11 +700,56 @@ Tcl_CreateEnsemble(
 	((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble;
     }
 
+    return ensemblePtr->token;
+
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateEnsemble
+ *
+ *	Create a simple ensemble attached to the given namespace.
+ *
+ *	Deprecated by TclCreateEnsembleInNs.
+ *
+ * Value
+ *
+ *	The token for the command created.
+ *
+ * Effect
+ *	The ensemble is created and marked for compilation.
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_CreateEnsemble(
+    Tcl_Interp *interp,
+    const char *name,
+    Tcl_Namespace *namespacePtr,
+    int flags)
+{
+    Tcl_Obj *nameObj = NULL;
+    Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr,
+    	*actualNsPtr;
+    const char * simpleName;
+
+    if (nsPtr == NULL) {
+	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    }
+
+    TclGetNamespaceForQualName(interp, name, nsPtr, 0,
+    	&foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
     if (nameObj != NULL) {
-	TclDecrRefCount(nameObj);
+    	TclDecrRefCount(nameObj);
     }
-    return ensemblePtr->token;
+    return TclCreateEnsembleInNs(interp, simpleName,
+	(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -1885,6 +1921,7 @@ NsEnsembleImplementationCmdNR(
 
 	TclSkipTailcall(interp);
 	Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
+	((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;
 	return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
     }
 
@@ -2635,10 +2672,7 @@ BuildEnsembleConfig(
 			Tcl_Obj *cmdObj, *cmdPrefixObj;
 
 			TclNewObj(cmdObj);
-			Tcl_AppendStringsToObj(cmdObj,
-				ensemblePtr->nsPtr->fullName,
-				(ensemblePtr->nsPtr->parentPtr ? "::" : ""),
-				nsCmdName, NULL);
+			Tcl_AppendStringsToObj(cmdObj, nsCmdName, NULL);
 			cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
 			Tcl_SetHashValue(hPtr, cmdPrefixObj);
 			Tcl_IncrRefCount(cmdPrefixObj);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 23a20e6..480ae5a 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2917,6 +2917,19 @@ MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
 			    Tcl_Obj *originObjPtr);
 MODULE_SCOPE int	TclConvertElement(const char *src, int length,
 			    char *dst, int flags);
+MODULE_SCOPE Tcl_Command tclCreateObjCommandInNs (
+			    Tcl_Interp *interp,
+			    const char *cmdName,
+			    Tcl_Namespace *nsPtr,
+			    Tcl_ObjCmdProc *proc,
+			    ClientData clientData,
+			    Tcl_CmdDeleteProc *deleteProc);
+MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(
+			    Tcl_Interp *interp,
+			    const char *name,
+			    Tcl_Namespace *nameNamespacePtr,
+			    Tcl_Namespace *ensembleNamespacePtr,
+			    int flags);
 MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
 MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
 			    const char *dict, int dictLength,
@@ -2945,6 +2958,10 @@ MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
 MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
 MODULE_SCOPE Tcl_Obj *const *	TclFetchEnsembleRoot(Tcl_Interp *interp,
 			    Tcl_Obj *const *objv, int objc, int *objcPtr);
+Tcl_Namespace * 	TclEnsureNamespace(
+			    Tcl_Interp *interp,
+			    Tcl_Namespace *namespacePtr);
+
 MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
 MODULE_SCOPE void	TclFinalizeAsync(void);
 MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
@@ -2971,6 +2988,15 @@ MODULE_SCOPE double	TclFloor(const mp_int *a);
 MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
 MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
 			    const char *attributeName, int *indexPtr);
+MODULE_SCOPE Tcl_Command tclNRCreateCommandInNs (
+			    Tcl_Interp *interp,
+			    const char *cmdName,
+			    Tcl_Namespace *nsPtr,
+			    Tcl_ObjCmdProc *proc,
+			    Tcl_ObjCmdProc *nreProc,
+			    ClientData clientData,
+			    Tcl_CmdDeleteProc *deleteProc);
+
 MODULE_SCOPE int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 			    const char *encodingName);
 MODULE_SCOPE void	TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index e1bad0e..e7914ad 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -2424,6 +2424,35 @@ TclGetNamespaceForQualName(
 /*
  *----------------------------------------------------------------------
  *
+ * TclEnsureNamespace --
+ *
+ *	Provide a namespace that is not deleted.
+ *
+ * Value
+ *
+ *	namespacePtr, if it is not scheduled for deletion, or a pointer to a
+ *	new namespace with the same name otherwise.
+ *
+ * Effect
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Namespace *
+TclEnsureNamespace(
+    Tcl_Interp *interp,
+    Tcl_Namespace *namespacePtr)
+{
+    Namespace *nsPtr = (Namespace *) namespacePtr;
+    if (!nsPtr->flags & NS_DYING) {
+	    return namespacePtr;
+    }
+    return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_FindNamespace --
  *
  *	Searches for a namespace.
@@ -2638,7 +2667,7 @@ Tcl_FindCommand(
 	Namespace *nsPtr[2];
 	register int search;
 
-	TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
+	TclGetNamespaceForQualName(interp, name, cxtNsPtr,
 		flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
 
 	/*
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 8fc6dcb..f5f2b03 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -128,7 +128,6 @@ Tcl_ProcObjCmd(
     const char *procName, *procArgs, *procBody;
     Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
     Tcl_Command cmd;
-    Tcl_DString ds;
 
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "name args body");
@@ -180,23 +179,8 @@ Tcl_ProcObjCmd(
 	return TCL_ERROR;
     }
 
-    /*
-     * Now create a command for the procedure. This will initially be in the
-     * current namespace unless the procedure's name included namespace
-     * qualifiers. To create the new command in the right namespace, we
-     * generate a fully qualified name for it.
-     */
-
-    Tcl_DStringInit(&ds);
-    if (nsPtr != iPtr->globalNsPtr) {
-	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
-	TclDStringAppendLiteral(&ds, "::");
-    }
-    Tcl_DStringAppend(&ds, procName, -1);
-
-    cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
-	    TclNRInterpProc, procPtr, TclProcDeleteProc);
-    Tcl_DStringFree(&ds);
+    cmd = tclNRCreateCommandInNs(interp, procName, (Tcl_Namespace *) nsPtr,
+	TclObjInterpProc, TclNRInterpProc, procPtr, TclProcDeleteProc);
 
     /*
      * Now initialize the new procedure's cmdPtr field. This will be used
diff --git a/tests/namespace.test b/tests/namespace.test
index f6f817b..220fa53 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1784,7 +1784,7 @@ test namespace-42.7 {ensembles: nested} -body {
     list [ns x0 z] [ns x1] [ns x2] [ns x3]
 } -cleanup {
     namespace delete ns
-} -result {{1 ::ns::x0::z} 1 2 3}
+} -result {{1 z} 1 2 3}
 test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
     proc demo args {}
     variable target [list [namespace which demo] x]
@@ -2084,7 +2084,7 @@ test namespace-47.1 {ensemble: unknown handler} {
     lappend result [catch {ns c d e} msg] $msg
     lappend result [catch {ns Magic foo bar spong wibble} msg] $msg
     list $result [lsort [info commands ::ns::*]] $log [namespace delete ns]
-} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running ::ns::a b c} {running ::ns::a b c} {making b} {running ::ns::b c d} {making c} {running ::ns::c d e} {unknown Magic - args = foo bar spong wibble}} {}}
+} {{0 2 0 2 0 2 0 2 1 {unknown or protected subcommand "Magic"}} {::ns::Magic ::ns::a ::ns::b ::ns::c} {{making a} {running a b c} {running a b c} {making b} {running b c d} {making c} {running c d e} {unknown Magic - args = foo bar spong wibble}} {}}
 test namespace-47.2 {ensemble: unknown handler} {
     namespace eval ns {
 	namespace export {[a-z]*}
@@ -3183,7 +3183,7 @@ test namespace-53.10 {ensembles: nested rewrite} -setup {
     1 {wrong # args: should be "ns z1 x a1"}\
     1 {wrong # args: should be "ns z2 x a1 a2"}\
     1 {wrong # args: should be "ns z2 x a1 a2"}\
-    1 {wrong # args: should be "::ns::x::z0"}\
+    1 {wrong # args: should be "z0"}\
     0 {1 v}\
     1 {wrong # args: should be "ns v x z2 a2"}\
     0 {2 v v2}}
@@ -3267,6 +3267,18 @@ test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} {
 	}
     }
 } {::testing::abc::def ::testing::abc::ghi}
+
+test namespace-56.4 {bug 16fe1b5807: names starting with ":"} {
+namespace eval : {
+    namespace ensemble create
+    namespace export *
+    proc p1 {} {
+	    return 16fe1b5807
+    }
+}
+
+: p1
+} 16fe1b5807
 
 # cleanup
 catch {rename cmd1 {}}
-- 
cgit v0.12


From 42c80667fd7da57b65d92fee77d2b954fba95970 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Fri, 17 Nov 2017 23:42:16 +0000
Subject: Lift the restriction on command names names that begin with ":".

---
 generic/tclBasic.c | 8 --------
 generic/tclProc.c  | 8 --------
 2 files changed, 16 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 334febc..a51578c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -9042,14 +9042,6 @@ TclNRCoroutineObjCmd(
         Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
 	return TCL_ERROR;
     }
-    if ((nsPtr != iPtr->globalNsPtr)
-	    && (procName != NULL) && (procName[0] == ':')) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "can't create procedure \"%s\" in non-global namespace with"
-                " name starting with \":\"", procName));
-        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
-	return TCL_ERROR;
-    }
 
     /*
      * We ARE creating the coroutine command: allocate the corresponding
diff --git a/generic/tclProc.c b/generic/tclProc.c
index f5f2b03..3c30623 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -158,14 +158,6 @@ Tcl_ProcObjCmd(
 	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
 	return TCL_ERROR;
     }
-    if ((nsPtr != iPtr->globalNsPtr)
-	    && (procName != NULL) && (procName[0] == ':')) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"can't create procedure \"%s\" in non-global namespace with"
-		" name starting with \":\"", procName));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
-	return TCL_ERROR;
-    }
 
     /*
      * Create the data structure to represent the procedure.
-- 
cgit v0.12


From 75924256c128fb94dc0cfbddf6d56fc89aeb10e7 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sun, 19 Nov 2017 00:06:51 +0000
Subject: Fix segmentation fault in TclOO that was noted in [16fe1b5807]. 
 Update coroutine and TclOO object creation routines to use
 TclCreateObjCommandInNs.

---
 generic/tclBasic.c    | 46 +++++++++++++++++-----------------------------
 generic/tclEnsemble.c | 12 +++---------
 generic/tclInt.h      |  4 ++--
 generic/tclOO.c       | 37 +++++++++++++++++++++----------------
 generic/tclProc.c     | 22 +++++++++++-----------
 tests/namespace.test  |  2 +-
 6 files changed, 55 insertions(+), 68 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a51578c..2acd2e7 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2281,11 +2281,11 @@ Tcl_CreateObjCommand(
 	tail = cmdName;
     }
 
-    return tclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr,
+    return TclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr,
 	proc, clientData, deleteProc);
 }
 
-Tcl_Command tclCreateObjCommandInNs (
+Tcl_Command TclCreateObjCommandInNs (
     Tcl_Interp *interp,
     const char *cmdName,	/* Name of command, without any namespace components */
     Tcl_Namespace *namespace,   /* The namespace to create the command in */
@@ -8210,7 +8210,7 @@ Tcl_NRCreateCommand(
     return (Tcl_Command) cmdPtr;
 }
 
-Tcl_Command tclNRCreateCommandInNs (
+Tcl_Command TclNRCreateCommandInNs (
     Tcl_Interp *interp,
     const char *cmdName,
     Tcl_Namespace *nsPtr,
@@ -8219,7 +8219,7 @@ Tcl_Command tclNRCreateCommandInNs (
     ClientData clientData,
     Tcl_CmdDeleteProc *deleteProc) {
     Command *cmdPtr = (Command *)
-	tclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
+	TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
 
     cmdPtr->nreProc = nreProc;
     return (Tcl_Command) cmdPtr;
@@ -9009,9 +9009,9 @@ TclNRCoroutineObjCmd(
 {
     Command *cmdPtr;
     CoroutineData *corPtr;
-    const char *fullName, *procName;
-    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
-    Tcl_DString ds;
+    const char *procName, *simpleName;
+    Namespace *nsPtr, *altNsPtr, *cxtNsPtr,
+	*inNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
     Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr;
 
     if (objc < 3) {
@@ -9019,27 +9019,22 @@ TclNRCoroutineObjCmd(
 	return TCL_ERROR;
     }
 
-    /*
-     * FIXME: this is copy/pasted from Tcl_ProcObjCommand. Should have
-     * something in tclUtil.c to find the FQ name.
-     */
-
-    fullName = TclGetString(objv[1]);
-    TclGetNamespaceForQualName(interp, fullName, NULL, 0,
-	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
+    procName = TclGetString(objv[1]);
+    TclGetNamespaceForQualName(interp, procName, inNsPtr, 0,
+	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
 
     if (nsPtr == NULL) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                 "can't create procedure \"%s\": unknown namespace",
-                fullName));
+                procName));
         Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL);
 	return TCL_ERROR;
     }
-    if (procName == NULL) {
+    if (simpleName == NULL) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                 "can't create procedure \"%s\": bad procedure name",
-                fullName));
-        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
+                procName));
+        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
 	return TCL_ERROR;
     }
 
@@ -9050,16 +9045,9 @@ TclNRCoroutineObjCmd(
 
     corPtr = ckalloc(sizeof(CoroutineData));
 
-    Tcl_DStringInit(&ds);
-    if (nsPtr != iPtr->globalNsPtr) {
-	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
-	TclDStringAppendLiteral(&ds, "::");
-    }
-    Tcl_DStringAppend(&ds, procName, -1);
-
-    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
-	    /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine);
-    Tcl_DStringFree(&ds);
+    cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName,
+	    (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine,
+	    corPtr, DeleteCoroutine);
 
     corPtr->cmdPtr = cmdPtr;
     cmdPtr->refCount++;
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 28802b0..cce7666 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -665,7 +665,7 @@ TclCreateEnsembleInNs(
     Tcl_Command token;
 
     ensemblePtr = ckalloc(sizeof(EnsembleConfig));
-    token = tclNRCreateCommandInNs(interp, name,
+    token = TclNRCreateCommandInNs(interp, name,
 	(Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
 	NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
     if (token == NULL) {
@@ -2605,12 +2605,7 @@ BuildEnsembleConfig(
 	     * the programmer's responsibility (or [::unknown] of course).
 	     */
 
-	    cmdObj = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr);
-	    if (ensemblePtr->nsPtr->parentPtr != NULL) {
-		Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
-	    } else {
-		Tcl_AppendStringsToObj(cmdObj, name, NULL);
-	    }
+	    cmdObj = Tcl_NewStringObj(name, -1);
 	    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
 	    Tcl_SetHashValue(hPtr, cmdPrefixObj);
 	    Tcl_IncrRefCount(cmdPrefixObj);
@@ -2671,8 +2666,7 @@ BuildEnsembleConfig(
 		    if (isNew) {
 			Tcl_Obj *cmdObj, *cmdPrefixObj;
 
-			TclNewObj(cmdObj);
-			Tcl_AppendStringsToObj(cmdObj, nsCmdName, NULL);
+			cmdObj = Tcl_NewStringObj(nsCmdName, -1);
 			cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
 			Tcl_SetHashValue(hPtr, cmdPrefixObj);
 			Tcl_IncrRefCount(cmdPrefixObj);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 480ae5a..7078ba0 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2917,7 +2917,7 @@ MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
 			    Tcl_Obj *originObjPtr);
 MODULE_SCOPE int	TclConvertElement(const char *src, int length,
 			    char *dst, int flags);
-MODULE_SCOPE Tcl_Command tclCreateObjCommandInNs (
+MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs (
 			    Tcl_Interp *interp,
 			    const char *cmdName,
 			    Tcl_Namespace *nsPtr,
@@ -2988,7 +2988,7 @@ MODULE_SCOPE double	TclFloor(const mp_int *a);
 MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
 MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
 			    const char *attributeName, int *indexPtr);
-MODULE_SCOPE Tcl_Command tclNRCreateCommandInNs (
+MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs (
 			    Tcl_Interp *interp,
 			    const char *cmdName,
 			    Tcl_Namespace *nsPtr,
diff --git a/generic/tclOO.c b/generic/tclOO.c
index e48158c..7feeb5d 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -562,7 +562,10 @@ AllocObject(
     Object *oPtr;
     Command *cmdPtr;
     CommandTrace *tracePtr;
+    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
+    Tcl_Namespace *inNsPtr;
     int creationEpoch, ignored;
+    const char *simpleName;
 
     oPtr = ckalloc(sizeof(Object));
     memset(oPtr, 0, sizeof(Object));
@@ -652,24 +655,18 @@ AllocObject(
      * command is deleted).
      */
 
-    if (!nameStr) {
-	oPtr->command = Tcl_CreateObjCommand(interp,
-		oPtr->namespacePtr->fullName, PublicObjectCmd, oPtr, NULL);
-    } else if (nameStr[0] == ':' && nameStr[1] == ':') {
-	oPtr->command = Tcl_CreateObjCommand(interp, nameStr,
-		PublicObjectCmd, oPtr, NULL);
+    if (nameStr) {
+	inNsPtr = TclGetCurrentNamespace(interp);
     } else {
-	Tcl_DString buffer;
-
-	Tcl_DStringInit(&buffer);
-	Tcl_DStringAppend(&buffer,
-		Tcl_GetCurrentNamespace(interp)->fullName, -1);
-	TclDStringAppendLiteral(&buffer, "::");
-	Tcl_DStringAppend(&buffer, nameStr, -1);
-	oPtr->command = Tcl_CreateObjCommand(interp,
-		Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL);
-	Tcl_DStringFree(&buffer);
+	nameStr = oPtr->namespacePtr->name;
+	inNsPtr = oPtr->namespacePtr;
     }
+    
+    TclGetNamespaceForQualName(interp, nameStr, (Namespace *) inNsPtr, 0,
+	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
+
+    oPtr->command = TclCreateObjCommandInNs(interp, simpleName,
+	(Tcl_Namespace *)nsPtr, PublicObjectCmd, oPtr, NULL);
 
     /*
      * Add the NRE command and trace directly. While this breaks a number of
@@ -1795,6 +1792,11 @@ TclNRNewObjectInstance(
     Object *oPtr;
 
     /*
+     * Protect classPtr from getting cleaned up when the command is created.
+     */
+    AddRef(classPtr);
+
+    /*
      * Check if we're going to create an object over an existing command;
      * that's not allowed.
      */
@@ -1841,11 +1843,13 @@ TclNRNewObjectInstance(
 
     if (objc < 0) {
 	*objectPtr = (Tcl_Object) oPtr;
+	DelRef(classPtr);
 	return TCL_OK;
     }
     contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
     if (contextPtr == NULL) {
 	*objectPtr = (Tcl_Object) oPtr;
+	DelRef(classPtr);
 	return TCL_OK;
     }
 
@@ -1869,6 +1873,7 @@ TclNRNewObjectInstance(
     TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
 	    objectPtr);
     TclPushTailcallPoint(interp);
+    DelRef(classPtr);
     return TclOOInvokeContext(contextPtr, interp, objc, objv);
 }
 
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 3c30623..b89357c 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -124,8 +124,8 @@ Tcl_ProcObjCmd(
 {
     register Interp *iPtr = (Interp *) interp;
     Proc *procPtr;
-    const char *fullName;
-    const char *procName, *procArgs, *procBody;
+    const char *procName;
+    const char *simpleName, *procArgs, *procBody;
     Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
     Tcl_Command cmd;
 
@@ -140,21 +140,21 @@ Tcl_ProcObjCmd(
      * namespace.
      */
 
-    fullName = TclGetString(objv[1]);
-    TclGetNamespaceForQualName(interp, fullName, NULL, 0,
-	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
+    procName = TclGetString(objv[1]);
+    TclGetNamespaceForQualName(interp, procName, NULL, 0,
+	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
 
     if (nsPtr == NULL) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"can't create procedure \"%s\": unknown namespace",
-		fullName));
+		procName));
 	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
 	return TCL_ERROR;
     }
-    if (procName == NULL) {
+    if (simpleName == NULL) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"can't create procedure \"%s\": bad procedure name",
-		fullName));
+		procName));
 	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
 	return TCL_ERROR;
     }
@@ -163,15 +163,15 @@ Tcl_ProcObjCmd(
      * Create the data structure to represent the procedure.
      */
 
-    if (TclCreateProc(interp, nsPtr, procName, objv[2], objv[3],
+    if (TclCreateProc(interp, nsPtr, simpleName, objv[2], objv[3],
 	    &procPtr) != TCL_OK) {
 	Tcl_AddErrorInfo(interp, "\n    (creating proc \"");
-	Tcl_AddErrorInfo(interp, procName);
+	Tcl_AddErrorInfo(interp, simpleName);
 	Tcl_AddErrorInfo(interp, "\")");
 	return TCL_ERROR;
     }
 
-    cmd = tclNRCreateCommandInNs(interp, procName, (Tcl_Namespace *) nsPtr,
+    cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
 	TclObjInterpProc, TclNRInterpProc, procPtr, TclProcDeleteProc);
 
     /*
diff --git a/tests/namespace.test b/tests/namespace.test
index 220fa53..de96682 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1920,7 +1920,7 @@ test namespace-44.5 {ensemble: errors} -setup {
     foobar foobarcon
 } -cleanup {
     rename foobar {}
-} -returnCodes error -result {invalid command name "::foobarconfigure"}
+} -returnCodes error -result {invalid command name "foobarconfigure"}
 test namespace-44.6 {ensemble: errors} -returnCodes error -body {
     namespace ensemble create gorp
 } -result {wrong # args: should be "namespace ensemble create ?option value ...?"}
-- 
cgit v0.12


From 9b1ecce298fc120bc981d5182cc9c45bcfb0971d Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Thu, 23 Nov 2017 18:24:09 +0000
Subject: Move return type to its own line.

---
 generic/tclBasic.c | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 2acd2e7..2f05425 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2285,7 +2285,8 @@ Tcl_CreateObjCommand(
 	proc, clientData, deleteProc);
 }
 
-Tcl_Command TclCreateObjCommandInNs (
+Tcl_Command
+TclCreateObjCommandInNs (
     Tcl_Interp *interp,
     const char *cmdName,	/* Name of command, without any namespace components */
     Tcl_Namespace *namespace,   /* The namespace to create the command in */
@@ -8210,7 +8211,8 @@ Tcl_NRCreateCommand(
     return (Tcl_Command) cmdPtr;
 }
 
-Tcl_Command TclNRCreateCommandInNs (
+Tcl_Command
+TclNRCreateCommandInNs (
     Tcl_Interp *interp,
     const char *cmdName,
     Tcl_Namespace *nsPtr,
-- 
cgit v0.12