diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2009-01-29 11:28:49 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2009-01-29 11:28:49 (GMT) |
commit | c9a954906d56f11f9fef33cff16fed13bf7b6151 (patch) | |
tree | 77402ce198ba0b916e8e094958de51fd8374ad00 /generic/tclNamesp.c | |
parent | 8b6830d61d7629ebf10cec3f12fe6c0c97ef8ea2 (diff) | |
download | tcl-c9a954906d56f11f9fef33cff16fed13bf7b6151.zip tcl-c9a954906d56f11f9fef33cff16fed13bf7b6151.tar.gz tcl-c9a954906d56f11f9fef33cff16fed13bf7b6151.tar.bz2 |
Fix [Bug 2529117]
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r-- | generic/tclNamesp.c | 61 |
1 files changed, 40 insertions, 21 deletions
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; } |