Index: generic/tclBasic.c =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v retrieving revision 1.85 diff -u -r1.85 tclBasic.c --- generic/tclBasic.c 25 Jun 2003 23:02:11 -0000 1.85 +++ generic/tclBasic.c 10 Aug 2003 21:43:04 -0000 @@ -1250,6 +1250,14 @@ } /* + * The list of command exported from the namespace might have + * changed. However, we do not need to recompute this just yet; + * next time we need the info will be soon enough. + */ + + TclInvalidateNsCmdLookup(cmdPtr->nsPtr); + + /* * Now link the hash table entry with the command structure. * We ensured above that the nsPtr was right. */ @@ -1379,6 +1387,14 @@ } /* + * The list of command exported from the namespace might have + * changed. However, we do not need to recompute this just yet; + * next time we need the info will be soon enough. + */ + + TclInvalidateNsCmdLookup(nsPtr); + + /* * Remove the hash entry for the command from the interpreter hidden * command table. */ @@ -1517,6 +1533,14 @@ ckfree((char*) Tcl_GetHashValue(hPtr)); } + } else { + /* + * The list of command exported from the namespace might have + * changed. However, we do not need to recompute this just + * yet; next time we need the info will be soon enough. + */ + + TclInvalidateNsCmdLookup(nsPtr); } cmdPtr = (Command *) ckalloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); @@ -1679,6 +1703,14 @@ ckfree((char *) Tcl_GetHashValue(hPtr)); } + } else { + /* + * The list of command exported from the namespace might have + * changed. However, we do not need to recompute this just + * yet; next time we need the info will be soon enough. + */ + + TclInvalidateNsCmdLookup(nsPtr); } cmdPtr = (Command *) ckalloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); @@ -2017,6 +2049,16 @@ } /* + * The list of command exported from the namespace might have + * changed. However, we do not need to recompute this just yet; + * next time we need the info will be soon enough. These might + * refer to the same variable, but that's no big deal. + */ + + TclInvalidateNsCmdLookup(cmdNsPtr); + TclInvalidateNsCmdLookup(cmdPtr->nsPtr); + + /* * Script for rename traces can delete the command "oldName". * Therefore increment the reference count for cmdPtr so that * it's Command structure is freed only towards the end of this @@ -2461,7 +2503,15 @@ } cmdPtr->tracePtr = NULL; } - + + /* + * The list of command exported from the namespace might have + * changed. However, we do not need to recompute this just yet; + * next time we need the info will be soon enough. + */ + + TclInvalidateNsCmdLookup(cmdPtr->nsPtr); + /* * If the command being deleted has a compile procedure, increment the * interpreter's compileEpoch to invalidate its compiled code. This Index: generic/tclInt.h =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v retrieving revision 1.130 diff -u -r1.130 tclInt.h --- generic/tclInt.h 24 Jul 2003 18:16:30 -0000 1.130 +++ generic/tclInt.h 10 Aug 2003 21:43:04 -0000 @@ -119,6 +119,8 @@ *---------------------------------------------------------------- */ +typedef struct Tcl_Ensemble Tcl_Ensemble; + /* * The structure below defines a namespace. * Note: the first five fields must match exactly the fields in a @@ -212,6 +214,14 @@ * within LookupCompiledLocal to resolve * variable references within the namespace * at compile time. */ + int exportLookupEpoch; /* Incremented whenever a command is added to + * a namespace, removed from a namespace or + * the exports of a namespace are changed. + * Allows TIP#112-driven command lists to be + * validated efficiently. */ + Tcl_Ensemble *ensemble; /* The structure that contains the details of + * the ensemble that is implemented on top of + * this namespace. */ } Namespace; /* @@ -1570,6 +1580,7 @@ extern Tcl_ObjType tclArraySearchType; extern Tcl_ObjType tclIndexType; extern Tcl_ObjType tclNsNameType; +extern Tcl_ObjType tclEnsembleCmdType; extern Tcl_ObjType tclWideIntType; /* @@ -2273,11 +2284,27 @@ * CONST Tcl_UniChar *ct, unsigned long n)); *---------------------------------------------------------------- */ + #ifdef WORDS_BIGENDIAN # define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar)) #else /* !WORDS_BIGENDIAN */ # define TclUniCharNcmp Tcl_UniCharNcmp #endif /* WORDS_BIGENDIAN */ + +/* + *---------------------------------------------------------------- + * Macro used by the Tcl core to increment a namespace's export + * export epoch counter. + * The ANSI C "prototype" for this macro is: + * + * EXTERN void TclInvalidateNsCmdLookup _ANSI_ARGS_((Namespace *nsPtr)); + *---------------------------------------------------------------- + */ + +#define TclInvalidateNsCmdLookup(nsPtr) \ + if ((nsPtr)->numExportPatterns) { \ + (nsPtr)->exportLookupEpoch++; \ + } #include "tclIntDecls.h" Index: generic/tclNamesp.c =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v retrieving revision 1.32 diff -u -r1.32 tclNamesp.c --- generic/tclNamesp.c 18 Jun 2003 18:30:01 -0000 1.32 +++ generic/tclNamesp.c 10 Aug 2003 21:43:05 -0000 @@ -10,6 +10,7 @@ * Copyright (c) 1993-1997 Lucent Technologies. * Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. + * Copyright (c) 2002 Donal K. Fellows. * * Originally implemented by * Michael J. McLennan @@ -74,15 +75,71 @@ } ResolvedNsName; /* + * The client data for an ensemble command. This consists of the + * table of commands that are actually exported by the namespace, and + * an epoch counter that, combined with the exportLookupEpoch field of + * the namespace structure, defines whether the table contains valid + * data or will need to be recomputed next time the ensemble command + * is called. + */ + +typedef struct EnsembleConfig { + Namespace *nsPtr; /* The namspace backing this ensemble up. */ + Tcl_Command token; /* The token for the command that provides + * ensemble support for the namespace, or + * NULL if the command has been deleted (or + * never existed; the global namespace never + * has an ensemble command.) */ + int epoch; /* The epoch at which this ensemble's table of + * exported commands is valid. */ + int numSubcommands; /* Number of ensemble subcommands. */ + char **subcommandArrayPtr; /* Array of ensemble subcommand names. */ + Tcl_HashTable subcommandTable; + /* Hash table of ensemble subcommand names, + * which are its keys so this also provides + * the storage management for those subcommand + * names. The contents of the entry values are + * object version the prefix lists to use when + * substituting for the command/subcommand to + * build the ensemble implementation command. + * Has to be stored here as well as in + * subcommandDict because that field is NULL + * when we are deriving the ensemble from the + * namespace exports list. */ + Tcl_Obj *subcommandDict; /* Dictionary providing mapping from + * subcommands to their implementing command + * prefixes, or NULL if we are to build the + * map automatically from the namespace + * exports. */ +} EnsembleConfig; + +/* + * The data cached in a subcommand's Tcl_Obj rep. This structure is + * not shared between Tcl_Objs referring to the same subcommand, even + * where one is a duplicate of another. + */ + +typedef struct EnsembleCmdRep { + Namespace *nsPtr; /* The namespace backing the ensemble which + * this is a subcommand of. */ + int epoch; /* Used to confirm when the data in this + * really structure matches up with the + * ensemble. */ + char *fullSubcmdName; /* The full (local) name of the subcommand, + * allocated with ckalloc(). */ + Tcl_Obj *realPrefixObj; /* Object containing the prefix words of the + * command that implements this ensemble + * subcommand. */ +} EnsembleCmdRep; + +/* * Declarations for procedures local to this file: */ -static void DeleteImportedCmd _ANSI_ARGS_(( - ClientData clientData)); +static void DeleteImportedCmd _ANSI_ARGS_((ClientData clientData)); static void DupNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr, Tcl_Obj *copyPtr)); -static void FreeNsNameInternalRep _ANSI_ARGS_(( - Tcl_Obj *objPtr)); +static void FreeNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); static int GetNamespaceFromObj _ANSI_ARGS_(( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr)); @@ -101,6 +158,9 @@ static int NamespaceDeleteCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +static int NamespaceEnsembleCmd _ANSI_ARGS_(( + ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); static int NamespaceEvalCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -138,6 +198,22 @@ static int SetNsNameFromAny _ANSI_ARGS_(( Tcl_Interp *interp, Tcl_Obj *objPtr)); static void UpdateStringOfNsName _ANSI_ARGS_((Tcl_Obj *objPtr)); +static int NsEnsembleImplementationCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[])); +static int BuildEnsembleConfig _ANSI_ARGS_(( + EnsembleConfig *ensemblePtr)); +static int NsEnsembleStringOrder _ANSI_ARGS_((CONST VOID *strPtr1, + CONST VOID *strPtr2)); +static void DeleteEnsembleConfig _ANSI_ARGS_(( + ClientData clientData)); +static void MakeCachedEnsembleCommand _ANSI_ARGS_(( + Tcl_Obj *objPtr, EnsembleConfig *ensemblePtr, + CONST char *subcmdName, Tcl_Obj *prefixObjPtr)); +static void FreeEnsembleCmdRep _ANSI_ARGS_((Tcl_Obj *objPtr)); +static void DupEnsembleCmdRep _ANSI_ARGS_((Tcl_Obj *objPtr, + Tcl_Obj *copyPtr)); +static void StringOfEnsembleCmdRep _ANSI_ARGS_((Tcl_Obj *objPtr)); /* * This structure defines a Tcl object type that contains a @@ -153,6 +229,21 @@ UpdateStringOfNsName, /* updateStringProc */ SetNsNameFromAny /* setFromAnyProc */ }; + +/* + * This structure defines a Tcl object type that contains a reference + * to an ensemble subcommand (e.g. the "length" in [string length ab]) + * It is used to cache the mapping between the subcommand itself and + * the real command that implements it. + */ + +Tcl_ObjType tclEnsembleCmdType = { + "ensembleCommand", /* the type's name */ + FreeEnsembleCmdRep, /* freeIntRepProc */ + DupEnsembleCmdRep, /* dupIntRepProc */ + StringOfEnsembleCmdRep, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; /* *---------------------------------------------------------------------- @@ -534,6 +625,8 @@ nsPtr->cmdResProc = NULL; nsPtr->varResProc = NULL; nsPtr->compiledVarResProc = NULL; + nsPtr->exportLookupEpoch = 0; + nsPtr->ensemble = NULL; if (parentPtr != NULL) { entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName, @@ -604,6 +697,25 @@ Tcl_HashEntry *entryPtr; /* + * If the namespace has an associated ensemble command, delete it + * first. This leaves the actual contents of the namespace alone. + * Note that a namespace might not have an ensemble command + * associated with it; the global namespace never does, this might + * be a reentrant call to Tcl_DeleteNamespace(), or the user might + * have nuked the command. + */ + + if (nsPtr->ensemble != NULL) { + EnsembleConfig *ensemblePtr = (EnsembleConfig *) nsPtr->ensemble; + + /* + * Note that this kills the ensemble field of the namespace. + */ + + Tcl_DeleteCommandFromToken(nsPtr->interp, ensemblePtr->token); + } + + /* * If the namespace is on the call frame stack, it is marked as "dying" * (NS_DYING is OR'd into its flags): the namespace can't be looked up * by name but its commands and variables are still usable by those @@ -939,6 +1051,7 @@ } ckfree((char *) nsPtr->exportArrayPtr); nsPtr->exportArrayPtr = NULL; + TclInvalidateNsCmdLookup(nsPtr); nsPtr->numExportPatterns = 0; nsPtr->maxExportPatterns = 0; } @@ -1008,6 +1121,16 @@ nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy; nsPtr->numExportPatterns++; + + /* + * The list of commands actually exported from the namespace might + * have changed (probably will have!) However, we do not need to + * recompute this just yet; next time we need the info will be + * soon enough. + */ + + TclInvalidateNsCmdLookup(nsPtr); + return TCL_OK; #undef INIT_EXPORT_PATTERNS } @@ -2484,13 +2607,13 @@ register Tcl_Obj *CONST objv[]; /* Argument objects. */ { static CONST char *subCmds[] = { - "children", "code", "current", "delete", + "children", "code", "current", "delete", "ensemble", "eval", "exists", "export", "forget", "import", "inscope", "origin", "parent", "qualifiers", "tail", "which", (char *) NULL }; enum NSSubCmdIdx { - NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx, + NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx, NSEnsembleIdx, NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx, NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx, NSTailIdx, NSWhichIdx @@ -2525,6 +2648,9 @@ case NSDeleteIdx: result = NamespaceDeleteCmd(clientData, interp, objc, objv); break; + case NSEnsembleIdx: + result = NamespaceEnsembleCmd(clientData, interp, objc, objv); + break; case NSEvalIdx: result = NamespaceEvalCmd(clientData, interp, objc, objv); break; @@ -3978,4 +4104,791 @@ objPtr->bytes[length] = '\0'; } objPtr->length = length; +} + +/* + *---------------------------------------------------------------------- + * + * NamespaceEnsembleCmd -- + * + * Invoked to implement the "namespace ensemble" command that + * creates and manipulates ensembles built on top of namespaces. + * Handles the following syntax: + * + * namespace ensemble name ?dictionary? + * + * Results: + * Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong. + * + * Side effects: + * Creates the ensemble for the namespace if one did not + * previously exist. Alternatively, alters the way that the + * ensemble's subcommand => implementation prefix is configured. + * + *---------------------------------------------------------------------- + */ +static int +NamespaceEnsembleCmd(dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + Tcl_Namespace *namespacePtr; + Namespace *nsPtr; + EnsembleConfig *ensemblePtr; + + if (objc < 3 || objc > 4) { + Tcl_WrongNumArgs(interp, 2, objv, + "name ?subcommandImplementationDictionary?"); + return TCL_ERROR; + } + + if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) { + return TCL_ERROR; + } + if (namespacePtr == NULL) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "unknown namespace \"", TclGetString(objv[2]), + "\" in namespace ensemble command", (char *) NULL); + return TCL_ERROR; + } + if (namespacePtr == Tcl_GetGlobalNamespace(interp)) { + Tcl_SetResult(interp, + "the global namespace may not have an associated ensemble", + TCL_STATIC); + return TCL_ERROR; + } + + if (objc == 4) { + Tcl_DictSearch search; + Tcl_Obj *listObj; + int done, len; + + /* + * Verify that, if present, the subcommand mapping dictionary + * consists of a bunch of mappings to non-empty lists. We do + * not check to see whether the first argument of the list is + * resolvable to a particular command, as that prevents use of + * "unknown". + */ + + if (Tcl_DictObjFirst(interp, objv[3], &search, + NULL, &listObj, &done) != TCL_OK) { + return TCL_ERROR; + } + while (!done) { + if (Tcl_ListObjLength(interp, listObj, &len) != TCL_OK) { + Tcl_DictObjDone(&search); + return TCL_ERROR; + } + if (len < 1) { + Tcl_SetResult(interp, + "ensemble subcommand implementations must be non-empty lists", + TCL_STATIC); + Tcl_DictObjDone(&search); + return TCL_ERROR; + } + Tcl_DictObjNext(&search, NULL, &listObj, &done); + } + } + + nsPtr = (Namespace *) namespacePtr; + if (nsPtr->ensemble == NULL) { + /* CREATE */ + ensemblePtr = (EnsembleConfig *) ckalloc(sizeof(EnsembleConfig)); + ensemblePtr->nsPtr = nsPtr; + Tcl_InitHashTable(&ensemblePtr->subcommandTable, TCL_STRING_KEYS); + ensemblePtr->subcommandArrayPtr = NULL; + ensemblePtr->numSubcommands = 0; + ensemblePtr->epoch = 0; + if (objc == 3) { + ensemblePtr->subcommandDict = NULL; + } else { + int size; + Tcl_DictObjSize(NULL, objv[3], &size); + if (size > 0) { + ensemblePtr->subcommandDict = objv[3]; + Tcl_IncrRefCount(ensemblePtr->subcommandDict); + } else { + ensemblePtr->subcommandDict = NULL; + } + } + ensemblePtr->token = Tcl_CreateObjCommand(interp, nsPtr->fullName, + NsEnsembleImplementationCmd, (ClientData)ensemblePtr, + DeleteEnsembleConfig); + nsPtr->ensemble = (Tcl_Ensemble *) ensemblePtr; + /* + * Trigger an eventual recomputation of the ensemble command + * set. Note that this is slightly tricky, as it means that + * we are not actually counting the number of namespace export + * actions, but it is the simplest way to go! + */ + nsPtr->exportLookupEpoch++; + return TCL_OK; + } else if (objc == 4) { + /* MANIPULATE */ + int size; + ensemblePtr = (EnsembleConfig *) nsPtr->ensemble; + if (ensemblePtr->subcommandDict != NULL) { + Tcl_DecrRefCount(ensemblePtr->subcommandDict); + } + Tcl_DictObjSize(NULL, objv[3], &size); + if (size == 0) { + ensemblePtr->subcommandDict = NULL; + } else { + ensemblePtr->subcommandDict = objv[3]; + Tcl_IncrRefCount(ensemblePtr->subcommandDict); + } + /* + * Trigger an eventual recomputation of the ensemble command + * set. Note that this is slightly tricky, as it means that + * we are not actually counting the number of namespace export + * actions, but it is the simplest way to go! + */ + nsPtr->exportLookupEpoch++; + return TCL_OK; + } else { + /* INTROSPECT */ + ensemblePtr = (EnsembleConfig *) nsPtr->ensemble; + if (ensemblePtr->subcommandDict != NULL) { + Tcl_SetObjResult(interp, ensemblePtr->subcommandDict); + } + return TCL_OK; + } +} + +/* + *---------------------------------------------------------------------- + * + * NsEnsembleImplementationCmd -- + * + * Implements an ensemble of commands (being those exported by a + * namespace other than the global namespace) as a command with + * the same (short) name as the namespace in the parent namespace. + * + * Results: + * A standard Tcl result code. Will be TCL_ERROR if the command + * is not an unambiguous prefix of any command exported by the + * ensemble's namespace. + * + * Side effects: + * Depends on the command within the namespace that gets executed. + * If the ensemble itself returns TCL_ERROR, a descriptive error + * message will be placed in the interpreter's result. + * + *---------------------------------------------------------------------- + */ + +static int +NsEnsembleImplementationCmd(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + EnsembleConfig *ensemblePtr = (EnsembleConfig *) clientData; + /* The ensemble itself. */ + Tcl_Obj **tempObjv; /* Space used to construct the list of + * arguments to pass to the command + * that implements the ensemble + * subcommand. */ + int result; /* The result of the subcommand + * execution. */ + int tableLength; /* Number of subcommands in the + * ensemble. */ + Tcl_Obj *prefixObj; /* An object containing the prefix + * words of the command that implements + * the subcommand. */ + Tcl_HashEntry *hPtr; /* Used for efficient lookup of fully + * specified but not yet cached command + * names. */ + Tcl_Obj **prefixObjv; /* The list of objects to substitute in + * as the target command prefix. */ + int prefixObjc; /* Size of prefixObjv of course! */ + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument ...?"); + return TCL_ERROR; + } + + if (ensemblePtr->epoch != ensemblePtr->nsPtr->exportLookupEpoch) { + ensemblePtr->epoch = ensemblePtr->nsPtr->exportLookupEpoch; + tableLength = BuildEnsembleConfig(ensemblePtr); + } else { + /* + * Table of subcommands is still valid; therefore there might + * be a valid cache of discovered information which we can + * reuse. Do the check here, and if we're still valid, we can + * jump straight to the part where we do the invocation of the + * subcommand. + */ + + if (objv[1]->typePtr == &tclEnsembleCmdType) { + EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *) + objv[1]->internalRep.otherValuePtr; + if (ensembleCmd->nsPtr == ensemblePtr->nsPtr && + ensembleCmd->epoch == ensemblePtr->epoch) { + prefixObj = ensembleCmd->realPrefixObj; + goto runSubcommand; + } + } + + tableLength = ensemblePtr->numSubcommands; + } + + /* + * Look in the hashtable for the subcommand name; this is the + * fastest way of all. + */ + + hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, + TclGetString(objv[1])); + if (hPtr != NULL) { + char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr); + prefixObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr); + + /* + * Cache for later in the subcommand object. + */ + + MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj); + } else { + /* + * If we've not already confirmed the command with the hash as + * part of building our export table, we need to scan the + * sorted array for matches. + */ + + char *subcmdName; /* Name of the subcommand, or unique + * prefix of it (will be an error for + * a non-unique prefix). */ + char *fullName = NULL; /* Full name of the subcommand. */ + int stringLength, i; + + subcmdName = Tcl_GetStringFromObj(objv[1], &stringLength); + for (i=0 ; isubcommandArrayPtr[i], + (unsigned)stringLength); + if (cmp == 0) { + if (fullName != NULL) { + /* + * Since there's never the exact-match case to + * worry about (hash search filters this), getting + * here indicates that our subcommand is an + * ambiguous prefix of (at least) two exported + * subcommands, which is an error case. + */ + goto unknownOrAmbiguousSubcommand; + } + fullName = ensemblePtr->subcommandArrayPtr[i]; + } else if (cmp == 1) { + /* + * Because we are searching a sorted table, we can now + * stop searching because we have gone past anything + * that could possibly match. + */ + break; + } + } + if (fullName == NULL) { + /* + * The subcommand is not a prefix of anything, so bail out! + */ + goto unknownOrAmbiguousSubcommand; + } + hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, fullName); + if (hPtr == NULL) { + panic("full name %s not found in supposedly synchronized hash", + fullName); + } + prefixObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr); + + /* + * Cache for later in the subcommand object. + */ + + MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj); + } + + runSubcommand: + /* + * Do the real work of execution of the subcommand by building an + * array of objects (note that this is potentially not the same + * length as the number of arguments to this ensemble command), + * populating it and then feeding it back through the main + * command-lookup engine. In theory, we could look up the command + * in the namespace ourselves, as we already have the namespace in + * which it is guaranteed to exist, but we don't do that (the + * cacheing of the command object used should help with that.) + */ + + Tcl_IncrRefCount(prefixObj); + Tcl_ListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv); + tempObjv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *)*(objc-2+prefixObjc)); + memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc); + memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2)); + result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv, 0); + Tcl_DecrRefCount(prefixObj); + ckfree((char *)tempObjv); + return result; + + unknownOrAmbiguousSubcommand: + /* + * Cannot determine what subcommand to hand off to, so generate a + * (standard) failure message. Note the one odd case compared + * with standard ensemble-like command, which is where a namespace + * has no exported commands at all... + */ + Tcl_ResetResult(interp); + if (ensemblePtr->numSubcommands == 0) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "unknown subcommand \"", TclGetString(objv[1]), + "\": namespace ", ensemblePtr->nsPtr->fullName, + " does not export any commands", NULL); + return TCL_ERROR; + } + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "unknown or ambiguous subcommand \"", TclGetString(objv[1]), + "\": must be ", NULL); + if (ensemblePtr->numSubcommands == 1) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + ensemblePtr->subcommandArrayPtr[0], NULL); + } else { + int i; + for (i=0 ; inumSubcommands-1 ; i++) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + ensemblePtr->subcommandArrayPtr[i], ", ", NULL); + } + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "or ", ensemblePtr->subcommandArrayPtr[i], NULL); + } + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * MakeCachedEnsembleCommand -- + * + * Cache what we've computed so far; it's not nice to repeatedly + * copy strings about. Note that to do this, we start by + * deleting any old representation that there was (though if it + * was an out of date ensemble rep, we can skip some of the + * deallocation process.) + * + * Results: + * None + * + * Side effects: + * Alters the internal representation of the first object parameter. + * + *---------------------------------------------------------------------- + */ +static void +MakeCachedEnsembleCommand(objPtr, ensemblePtr, subcommandName, prefixObjPtr) + Tcl_Obj *objPtr; + EnsembleConfig *ensemblePtr; + CONST char *subcommandName; + Tcl_Obj *prefixObjPtr; +{ + register EnsembleCmdRep *ensembleCmd; + int length; + + if (objPtr->typePtr == &tclEnsembleCmdType) { + ensembleCmd = (EnsembleCmdRep *) objPtr->internalRep.otherValuePtr; + Tcl_DecrRefCount(ensembleCmd->realPrefixObj); + ensembleCmd->nsPtr->refCount--; + if ((ensembleCmd->nsPtr->refCount == 0) + && (ensembleCmd->nsPtr->flags & NS_DEAD)) { + NamespaceFree(ensembleCmd->nsPtr); + } + ckfree(ensembleCmd->fullSubcmdName); + } else { + /* + * Kill the old internal rep, and replace it with a brand new + * one of our own. + */ + if ((objPtr->typePtr != NULL) + && (objPtr->typePtr->freeIntRepProc != NULL)) { + objPtr->typePtr->freeIntRepProc(objPtr); + } + ensembleCmd = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep)); + objPtr->internalRep.otherValuePtr = (VOID *) ensembleCmd; + objPtr->typePtr = &tclEnsembleCmdType; + } + + /* + * Populate the internal rep. + */ + ensembleCmd->nsPtr = ensemblePtr->nsPtr; + ensemblePtr->nsPtr->refCount++; + ensembleCmd->realPrefixObj = prefixObjPtr; + length = strlen(subcommandName)+1; + ensembleCmd->fullSubcmdName = ckalloc((unsigned) length); + memcpy(ensembleCmd->fullSubcmdName, subcommandName, (unsigned) length); + Tcl_IncrRefCount(ensembleCmd->realPrefixObj); +} + +/* + *---------------------------------------------------------------------- + * + * DeleteEnsembleConfig -- + * + * Destroys the data structure used to represent an ensemble. + * This is called when the ensemble's command is deleted (which + * happens automatically if the ensemble's namespace is deleted.) + * Maintainers should note that the ensemble command's + * implementation does not read from this structure once it has + * invoked a subcommand, so no attempt is made to Tcl_Preserve() + * this structure. Also note that because an ensemble command is + * always deleted very early in the destruction of a namespace, + * there is no reference count in the main namespace structure + * associated with the ensemble structure. + * + * Results: + * None. + * + * Side effects: + * Memory is deallocated. + * + *---------------------------------------------------------------------- + */ + +static void +DeleteEnsembleConfig(clientData) + ClientData clientData; +{ + EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData; + Namespace *nsPtr = ensemblePtr->nsPtr; + Tcl_HashSearch search; + Tcl_HashEntry *hEnt; + + nsPtr->ensemble = NULL; + if (ensemblePtr->numSubcommands != 0) { + ckfree((char *)ensemblePtr->subcommandArrayPtr); + } + hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search); + while (hEnt != NULL) { + Tcl_Obj *prefixObj = (Tcl_Obj *) Tcl_GetHashValue(hEnt); + Tcl_DecrRefCount(prefixObj); + hEnt = Tcl_NextHashEntry(&search); + } + Tcl_DeleteHashTable(&ensemblePtr->subcommandTable); + if (ensemblePtr->subcommandDict != NULL) { + Tcl_DecrRefCount(ensemblePtr->subcommandDict); + } + ckfree((char *)ensemblePtr); +} + +/* + *---------------------------------------------------------------------- + * + * BuildEnsembleConfig -- + * + * Create the internal data structures that describe how an + * ensemble looks, being a hash mapping from the full command + * name to the Tcl list that describes the implementation prefix + * words, and a sorted array of all the full command names to + * allow for reasonably efficient unambiguous prefix handling. + * + * Results: + * The number of subcommands in the ensemble. + * + * Side effects: + * Reallocates and rebuilds the hash table and array stored at + * the ensemblePtr argument. For large ensembles or large + * namespaces, this is a potentially expensive operation. + * + *---------------------------------------------------------------------- + */ + +static int +BuildEnsembleConfig(ensemblePtr) + EnsembleConfig *ensemblePtr; +{ + Tcl_HashSearch search; /* Used for scanning the set of + * commands in the namespace that + * backs up this ensemble. */ + int tableLength; /* Size of the sorted table of + * subcommands. */ + int i, j; + Tcl_HashTable *hash = &ensemblePtr->subcommandTable; + Tcl_HashEntry *hPtr; + + if (ensemblePtr->numSubcommands != 0) { + /* + * Remove pre-existing table. + */ + ckfree((char *)ensemblePtr->subcommandArrayPtr); + Tcl_DeleteHashTable(hash); + Tcl_InitHashTable(hash, TCL_STRING_KEYS); + } + + if (ensemblePtr->subcommandDict != NULL) { + Tcl_DictSearch dictSearch; + Tcl_Obj *keyObj, *valueObj; + int done; + + /* + * Note that this is a non-empty dictionary. + */ + Tcl_DictObjSize(NULL, ensemblePtr->subcommandDict, &tableLength); + + ensemblePtr->numSubcommands = tableLength; + ensemblePtr->subcommandArrayPtr = (char **) + ckalloc(sizeof(char *) * tableLength); + Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch, + &keyObj, &valueObj, &done); + while (!done) { + char *name = TclGetString(keyObj); + hPtr = Tcl_CreateHashEntry(hash, name, &done); + Tcl_SetHashValue(hPtr, (ClientData) valueObj); + Tcl_IncrRefCount(valueObj); + Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done); + } + goto buildSortedTable; + } + + /* + * Discover what commands are actually exported by the + * namespace. What we have is an array of patterns and a hash + * table whose keys are the command names exported by the + * namespace (the contents do not matter here.) We must find + * out what commands are actually exported by filtering each + * command in the namespace against each of the patterns in + * the export list. Note that we use an intermediate hash + * table to make memory management easier, and because that + * makes exact matching far easier too. + * + * Suggestion for future enhancement: compute the unique + * prefixes and place them in the hash too, which should make + * for even faster matching. + */ + + hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search); + for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) { + char *nsCmdName = /* Name of command in namespace. */ + Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr); + + for (i=0 ; insPtr->numExportPatterns ; i++) { + if (Tcl_StringMatch(nsCmdName, + ensemblePtr->nsPtr->exportArrayPtr[i])) { + int isNew; + hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew); + + /* + * Remember, hash entries have a full reference to the + * substituted part of the command (as a list) as + * their content! + */ + + if (isNew) { + Tcl_Obj *cmdObj = + Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1); + Tcl_Obj *cmdPrefixObj; + Tcl_AppendStringsToObj(cmdObj, "::", nsCmdName, NULL); + cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); + Tcl_SetHashValue(hPtr, (ClientData) cmdPrefixObj); + Tcl_IncrRefCount(cmdPrefixObj); + } + break; + } + } + } + tableLength = ensemblePtr->numSubcommands = hash->numEntries; + if (tableLength == 0) { + ensemblePtr->subcommandArrayPtr = NULL; + return 0; + } + + /* + * Create a sorted array of all subcommands in the ensemble; hash + * tables are all very well for a quick look for an exact match, + * but they can't determine things like whether a string is a + * prefix of another (not without lots of preparation anyway) and + * they're no good for when we're generating the error message + * either. + * + * We do this by filling an array with the names (we use the hash + * keys directly to save a copy, since any time we change the + * array we change the hash too, and vice versa) and running + * quicksort over the array. + */ + + ensemblePtr->subcommandArrayPtr = (char **) + ckalloc(sizeof(char *) * tableLength); + + /* + * Fill array from both ends as this makes us less likely to end + * up with performance problems in qsort(), which is good. Note + * that doing this makes this code much more opaque, but the naive + * alternatve: + * + * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ; + * hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search),i++) { + * ensemblePtr->subcommandArrayPtr[i] = + * Tcl_GetHashKey(hash, &hPtr); + * } + * + * can produce long runs of precisely ordered table entries when + * the commands in the namespace are declared in a sorted fashion + * (an ordering some people like) and the hashing functions (or + * the command names themselves) are fairly unfortunate. By + * filling from both ends, it requires active malice (and probably + * a debugger) to get qsort() to have awful runtime behaviour. + */ + + buildSortedTable: + + i = 0; + j = tableLength; + hPtr = Tcl_FirstHashEntry(hash, &search); + while (hPtr != NULL) { + ensemblePtr->subcommandArrayPtr[i++] = Tcl_GetHashKey(hash, hPtr); + hPtr = Tcl_NextHashEntry(&search); + if (hPtr == NULL) { + break; + } + ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr); + hPtr = Tcl_NextHashEntry(&search); + } + if (tableLength > 1) { + qsort(ensemblePtr->subcommandArrayPtr, + (unsigned)tableLength, sizeof(char *), + NsEnsembleStringOrder); + } + return tableLength; +} + +/* + *---------------------------------------------------------------------- + * + * NsEnsembleStringOrder -- + * + * Helper function to compare two pointers to two strings for use + * with qsort(). + * + * Results: + * -1 if the first string is smaller, 1 if the second string is + * smaller, and 0 if they are equal. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +NsEnsembleStringOrder(strPtr1, strPtr2) + CONST VOID *strPtr1, *strPtr2; +{ + return strcmp(*(CONST char **)strPtr1, *(CONST char **)strPtr2); +} + +/* + *---------------------------------------------------------------------- + * + * FreeEnsembleCmdRep -- + * + * Destroys the internal representation of a Tcl_Obj that has been + * holding information about a command in an ensemble. + * + * Results: + * None. + * + * Side effects: + * Memory is deallocated. If this held the last reference to a + * namespace's main structure, that main structure will also be + * destroyed. + * + *---------------------------------------------------------------------- + */ + +static void +FreeEnsembleCmdRep(objPtr) + Tcl_Obj *objPtr; +{ + EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *) + objPtr->internalRep.otherValuePtr; + + Tcl_DecrRefCount(ensembleCmd->realPrefixObj); + ckfree(ensembleCmd->fullSubcmdName); + ensembleCmd->nsPtr->refCount--; + if ((ensembleCmd->nsPtr->refCount == 0) + && (ensembleCmd->nsPtr->flags & NS_DEAD)) { + NamespaceFree(ensembleCmd->nsPtr); + } + ckfree((char *)ensembleCmd); +} + +/* + *---------------------------------------------------------------------- + * + * DupEnsembleCmdRep -- + * + * Makes one Tcl_Obj into a copy of another that is a subcommand + * of an ensemble. + * + * Results: + * None. + * + * Side effects: + * Memory is allocated, and the namespace that the ensemble is + * built on top of gains another reference. + * + *---------------------------------------------------------------------- + */ + +static void +DupEnsembleCmdRep(objPtr, copyPtr) + Tcl_Obj *objPtr, *copyPtr; +{ + EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *) + objPtr->internalRep.otherValuePtr; + EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *) + ckalloc(sizeof(EnsembleCmdRep)); + int length = strlen(ensembleCmd->fullSubcmdName); + + copyPtr->typePtr = &tclEnsembleCmdType; + copyPtr->internalRep.otherValuePtr = (VOID *) ensembleCopy; + ensembleCopy->nsPtr = ensembleCmd->nsPtr; + ensembleCopy->epoch = ensembleCmd->epoch; + ensembleCopy->nsPtr->refCount++; + ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj; + Tcl_IncrRefCount(ensembleCopy->realPrefixObj); + ensembleCopy->fullSubcmdName = ckalloc((unsigned) length+1); + memcpy(ensembleCopy->fullSubcmdName, ensembleCmd->fullSubcmdName, + (unsigned) length+1); +} + +/* + *---------------------------------------------------------------------- + * + * StringOfEnsembleCmdRep -- + * + * Creates a string representation of a Tcl_Obj that holds a + * subcommand of an ensemble. + * + * Results: + * None. + * + * Side effects: + * The object gains a string (UTF-8) representation. + * + *---------------------------------------------------------------------- + */ + +static void +StringOfEnsembleCmdRep(objPtr) + Tcl_Obj *objPtr; +{ + EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *) + objPtr->internalRep.otherValuePtr; + int length = strlen(ensembleCmd->fullSubcmdName); + + objPtr->length = length; + objPtr->bytes = ckalloc((unsigned) length+1); + memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1); } Index: generic/tclObj.c =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v retrieving revision 1.49 diff -u -r1.49 tclObj.c --- generic/tclObj.c 24 Jul 2003 18:16:31 -0000 1.49 +++ generic/tclObj.c 10 Aug 2003 21:43:05 -0000 @@ -263,6 +263,7 @@ Tcl_RegisterObjType(&tclArraySearchType); Tcl_RegisterObjType(&tclIndexType); Tcl_RegisterObjType(&tclNsNameType); + Tcl_RegisterObjType(&tclEnsembleCmdType); Tcl_RegisterObjType(&tclCmdNameType); #ifdef TCL_COMPILE_STATS Index: tests/namespace.test =================================================================== RCS file: /cvsroot/tcl/tcl/tests/namespace.test,v retrieving revision 1.21 diff -u -r1.21 namespace.test --- tests/namespace.test 22 Jun 2002 04:19:47 -0000 1.21 +++ tests/namespace.test 10 Aug 2003 21:43:05 -0000 @@ -641,7 +641,7 @@ } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}} test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} { list [catch {namespace wombat {}} msg] $msg -} {1 {bad option "wombat": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}} +} {1 {bad option "wombat": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}} test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} { namespace ch :: test_ns_* } {} @@ -748,7 +748,7 @@ } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}} test namespace-25.2 {NamespaceEvalCmd, bad args} { list [catch {namespace test_ns_1} msg] $msg -} {1 {bad option "test_ns_1": must be children, code, current, delete, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}} +} {1 {bad option "test_ns_1": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, qualifiers, tail, or which}} catch {unset v} test namespace-25.3 {NamespaceEvalCmd, new namespace} { set v 123 @@ -1184,6 +1184,247 @@ set res } {{New proc is called} 0} +# Ensembles (TIP#112) +test namespace-42.1 {ensembles: basic} { + namespace eval ns { + namespace export x + proc x {} {format 1} + } + namespace ensemble ns + list [info command ns] [ns x] [namespace delete ns] [info command ns] +} {ns 1 {} {}} +test namespace-42.2 {ensembles: basic} { + namespace eval ns { + namespace export x + proc x {} {format 1} + } + namespace ensemble ns + rename ns foo + list [info command foo] [foo x] [namespace delete ns] [info command foo] +} {foo 1 {} {}} +test namespace-42.3 {ensembles: basic} { + namespace eval ns { + namespace export x* + proc x1 {} {format 1} + proc x2 {} {format 2} + } + namespace ensemble ns + set result [list [ns x1] [ns x2]] + lappend result [catch {ns x} msg] $msg + rename ns {} + lappend result [info command ns::x1] + namespace delete ns + lappend result [info command ns::x1] +} {1 2 1 {unknown or ambiguous subcommand "x": must be x1, or x2} ::ns::x1 {}} +test namespace-42.4 {ensembles: basic} { + namespace eval ns { + namespace export y* + proc x1 {} {format 1} + proc x2 {} {format 2} + } + namespace ensemble ns + set result [list [catch {ns x} msg] $msg] + namespace delete ns + set result +} {1 {unknown subcommand "x": namespace ::ns does not export any commands}} +test namespace-42.5 {ensembles: basic} { + namespace eval ns { + namespace export x* + proc x1 {} {format 1} + proc x2 {} {format 2} + proc x3 {} {format 3} + } + namespace ensemble ns + set result [list [catch {ns x} msg] $msg] + namespace delete ns + set result +} {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}} +test namespace-42.6 {ensembles: nested} { + namespace eval ns { + namespace export x* + namespace eval x0 { + proc z {} {format 0} + namespace export z + } + proc x1 {} {format 1} + proc x2 {} {format 2} + proc x3 {} {format 3} + } + namespace ensemble ns + namespace ensemble ns::x0 + set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]] + namespace delete ns + set result +} {0 1 2 3} +test namespace-42.7 {ensembles: nested} { + namespace eval ns { + namespace export x* + namespace eval x0 { + proc z {} {list [info level] [info level 1]} + namespace export z + } + proc x1 {} {format 1} + proc x2 {} {format 2} + proc x3 {} {format 3} + } + namespace ensemble ns + namespace ensemble ns::x0 + set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]] + namespace delete ns + set result +} {{1 ::ns::x0::z} 1 2 3} +test namespace-42.8 {ensembles: dict-driven} { + namespace eval ns { + namespace export x* + proc x1 {} {format 1} + proc x2 {} {format 2} + } + namespace ensemble ns {a x1 b x2} + set result [list [catch {ns c} msg] $msg] + namespace delete ns + set result +} {1 {unknown or ambiguous subcommand "c": must be a, or b}} +test namespace-42.9 {ensembles: dict-driven} { + namespace eval ns { + namespace export x* + proc x1 {args} {list 1 $args} + proc x2 {args} {list 2 [llength $args]} + } + namespace ensemble ns { + a ::ns::x1 b ::ns::x2 c {::ns::x1 .} d {::ns::x2 .} + } + set result [list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo]] + namespace delete ns + set result +} {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}} +test namespace-42.10 {ensemble: errors} { + list [catch {namespace ensemble} msg] $msg +} {1 {wrong # args: should be "namespace ensemble name ?subcommandImplementationDictionary?"}} +test namespace-42.11 {ensemble: errors} { + list [catch {namespace ensemble a a a} msg] $msg +} {1 {wrong # args: should be "namespace ensemble name ?subcommandImplementationDictionary?"}} +test namespace-42.12 {ensemble: errors} { + list [catch {namespace ensemble ns} msg] $msg +} {1 {unknown namespace "ns" in namespace ensemble command}} +test namespace-42.13 {ensemble: errors} { + list [catch {namespace ensemble ::} msg] $msg +} {1 {the global namespace may not have an associated ensemble}} +test namespace-42.14 {ensemble: errors} { + namespace eval ns {} + list [catch {namespace ensemble ns x} msg] $msg +} {1 {missing value to go with key}} +test namespace-42.15 {ensemble: errors} { + namespace eval ns {} + list [catch {namespace ensemble ns {x {}}} msg] $msg +} {1 {ensemble subcommand implementations must be non-empty lists}} +test namespace-42.16 {ensemble: introspection} { + namespace eval ns { + namespace export x + proc x {} {} + } + namespace ensemble ns + namespace ensemble ns +} {} +test namespace-42.17 {ensemble: introspection} { + namespace eval ns { + namespace export x + proc x {} {} + } + namespace ensemble ns {A x} + set result [namespace ensemble ns] + namespace delete ns + set result +} {A x} +test namespace-42.18 {ensemble: modification} { + namespace eval ns { + namespace export x + proc x {} {format 123} + } + namespace ensemble ns {A ::ns::x} + set result [list [namespace ensemble ns] [ns A]] + namespace ensemble ns {B ::ns::x} + lappend result [namespace ensemble ns] [ns B] + namespace ensemble ns {} + lappend result [namespace ensemble ns] [ns x] + namespace delete ns + set result +} {{A ::ns::x} 123 {B ::ns::x} 123 {} 123} +test namespace-42.19 {ensemble: ensembles really use current export list} { + namespace eval ns { + namespace export x1 + proc x1 {} {format 1} + proc x2 {} {format 1} + } + namespace ensemble ns + catch {ns ?} msg; set result [list $msg] + namespace eval ns {namespace export x*} + catch {ns ?} msg; lappend result $msg + rename ns::x1 {} + catch {ns ?} msg; lappend result $msg + namespace delete ns + set result +} {{unknown or ambiguous subcommand "?": must be x1} {unknown or ambiguous subcommand "?": must be x1, or x2} {unknown or ambiguous subcommand "?": must be x2}} +test namespace-42.20 {ensemble: implementation errors} { + namespace eval ns {variable count 0} + namespace ensemble ns {a {lappend ::result} b {incr ::ns::count}} + set result {} + lappend result [catch { ns } msg] $msg + ns a [ns b 10] + rename ns p + p a [p b 3000] + lappend result $ns::count + namespace delete ns + lappend result [info command p] +} {1 {wrong # args: should be "ns subcommand ?argument ...?"} 10 3010 3010 {}} +test namespace-42.21 {ensemble: implementation errors} { + namespace eval ns {} + namespace ensemble ns + set result [info command ns] + lappend result [catch {ns ?} msg] $msg + namespace delete ns + set result +} {ns 1 {unknown subcommand "?": namespace ::ns does not export any commands}} +test namespace-42.22 {ensemble: implementation errors} { + namespace eval ns {} + namespace ensemble ns {foo error} + list [catch {ns foo bar} msg] $msg $::errorInfo [namespace delete ns] +} {1 bar {bar + while executing +"error bar" + invoked from within +"ns foo bar"} {}} +test namespace-42.23 {ensemble: implementation renames/deletes itself} { + namespace eval ns {} + namespace ensemble ns {to rename} + ns to ns foo + foo to foo bar + bar to bar spong + spong to spong {} + namespace delete ns +} {} +test namespace-42.24 {ensemble: implementation deletes its namespace} { + namespace eval ns {} + namespace ensemble ns {kill {namespace delete}} + ns kill ns +} {} +test namespace-42.25 {ensemble: implementation deletes its namespace} { + namespace eval ns { + namespace export * + proc foo {} { + variable x 1 + bar + # Tricky; what is the correct return value anyway? + info exist x + } + proc bar {} { + namespace delete [namespace current] + } + } + namespace ensemble ns + list [ns foo] [info exist ns::x] +} {1 0} + + # cleanup catch {rename cmd1 {}} catch {unset l} @@ -1192,15 +1433,3 @@ eval namespace delete [namespace children :: test_ns_*] ::tcltest::cleanupTests return - - - - - - - - - - - -