summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-01-29 11:28:49 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-01-29 11:28:49 (GMT)
commitc9a954906d56f11f9fef33cff16fed13bf7b6151 (patch)
tree77402ce198ba0b916e8e094958de51fd8374ad00
parent8b6830d61d7629ebf10cec3f12fe6c0c97ef8ea2 (diff)
downloadtcl-c9a954906d56f11f9fef33cff16fed13bf7b6151.zip
tcl-c9a954906d56f11f9fef33cff16fed13bf7b6151.tar.gz
tcl-c9a954906d56f11f9fef33cff16fed13bf7b6151.tar.bz2
Fix [Bug 2529117]
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclNamesp.c61
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;
}