From c9a954906d56f11f9fef33cff16fed13bf7b6151 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 29 Jan 2009 11:28:49 +0000
Subject: Fix [Bug 2529117]

---
 ChangeLog           |  6 ++++++
 generic/tclNamesp.c | 61 +++++++++++++++++++++++++++++++++++------------------
 2 files changed, 46 insertions(+), 21 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 38ac7af..d230110 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2009-01-29  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclNamesp.c (TclMakeEnsemble): [Bug 2529117]: Make this
+	function behave more sensibly when presented with a fully-qualified
+	name, rather than doing strange stuff.
+
 2009-01-28  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclBasic.c (TclInvokeObjectCommand): Made this understand
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index a122164..63c3d1f 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.186 2009/01/28 16:28:32 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.187 2009/01/29 11:28:49 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -6159,24 +6159,39 @@ TclMakeEnsemble(
     Tcl_Command ensemble;
     Tcl_Namespace *ns;
     Tcl_DString buf;
-    const char **nameParts;
-    const char *cmdname;
+    const char **nameParts = NULL;
+    const char *cmdName = NULL;
     int i, nameCount = 0, ensembleFlags = 0;
 
     /*
-     * Construct the path for the ensemble namespace and create it
+     * Construct the path for the ensemble namespace and create it.
      */
 
     Tcl_DStringInit(&buf);
-    Tcl_DStringAppend(&buf, "::tcl", -1);
+    if (name[0] == ':' && name[1] == ':') {
+	/*
+	 * An absolute name, so use it directly.
+	 */
 
-    if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) {
-	Tcl_Panic("invalid ensemble name '%s'", name);
-    }
+	cmdName = name;
+	Tcl_DStringAppend(&buf, name, -1);
+	ensembleFlags = TCL_ENSEMBLE_PREFIX;
+    } else {
+	/*
+	 * Not an absolute name, so do munging of it. Note that this treats a
+	 * multi-word list differently to a single word.
+	 */
 
-    for (i = 0; i < nameCount; ++i) {
-	Tcl_DStringAppend(&buf, "::", 2);
-	Tcl_DStringAppend(&buf, nameParts[i], -1);
+	Tcl_DStringAppend(&buf, "::tcl", -1);
+
+	if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) {
+	    Tcl_Panic("invalid ensemble name '%s'", name);
+	}
+
+	for (i = 0; i < nameCount; ++i) {
+	    Tcl_DStringAppend(&buf, "::", 2);
+	    Tcl_DStringAppend(&buf, nameParts[i], -1);
+	}
     }
 
     ns = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL,
@@ -6190,17 +6205,19 @@ TclMakeEnsemble(
      * Create the named ensemble in the correct namespace
      */
 
-    if (nameCount == 1) {
-	ensembleFlags = TCL_ENSEMBLE_PREFIX;
-	cmdname = Tcl_DStringValue(&buf) + 5;
-    } else {
-	ns = ns->parentPtr;
-	cmdname = nameParts[nameCount - 1];
+    if (cmdName == NULL) {
+	if (nameCount == 1) {
+	    ensembleFlags = TCL_ENSEMBLE_PREFIX;
+	    cmdName = Tcl_DStringValue(&buf) + 5;
+	} else {
+	    ns = ns->parentPtr;
+	    cmdName = nameParts[nameCount - 1];
+	}
     }
-    ensemble = Tcl_CreateEnsemble(interp, cmdname, ns, ensembleFlags);
+    ensemble = Tcl_CreateEnsemble(interp, cmdName, ns, ensembleFlags);
 
     /*
-     * Create the ensemble mapping dictionary and the ensemble command procs
+     * Create the ensemble mapping dictionary and the ensemble command procs.
      */
 
     if (ensemble != NULL) {
@@ -6214,7 +6231,7 @@ TclMakeEnsemble(
 
 	    fromObj = Tcl_NewStringObj(map[i].name, -1);
 	    TclNewStringObj(toObj, Tcl_DStringValue(&buf),
-		Tcl_DStringLength(&buf));
+		    Tcl_DStringLength(&buf));
 	    Tcl_AppendToObj(toObj, map[i].name, -1);
 	    Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
 	    if (map[i].proc || map[i].nreProc) {
@@ -6234,7 +6251,9 @@ TclMakeEnsemble(
     }
 
     Tcl_DStringFree(&buf);
-    Tcl_Free((char *)nameParts);
+    if (nameParts != NULL) {
+	Tcl_Free((char *) nameParts);
+    }
     return ensemble;
 }
 
-- 
cgit v0.12