diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclIndexObj.c | 29 | ||||
| -rw-r--r-- | generic/tclInt.h | 24 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 66 |
4 files changed, 80 insertions, 46 deletions
@@ -1,3 +1,10 @@ +2007-06-12 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclIndexObj.c (Tcl_WrongNumArgs): + * generic/tclNamesp.c, generic/tclInt.h (tclEnsembleCmdType): Make + Tcl_WrongNumArgs do replacement correctly with ensembles and other + sorts of complex replacement strategies. + 2007-06-11 Miguel Sofer <msofer@users.sf.net> * generic/tclExecute.c: comments added to explain iPtr->numLevels diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index af0b444..df8d9ee 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIndexObj.c,v 1.32 2007/04/02 18:48:03 dgp Exp $ + * RCS: @(#) $Id: tclIndexObj.c,v 1.33 2007/06/12 12:29:05 dkf Exp $ */ #include "tclInt.h" @@ -449,7 +449,6 @@ Tcl_WrongNumArgs( { Tcl_Obj *objPtr; int i, len, elemLen, flags; - register IndexRep *indexRep; Interp *iPtr = (Interp *) interp; char *elementStr; @@ -521,11 +520,25 @@ Tcl_WrongNumArgs( * Add the element, quoting it if necessary. */ - elementStr = Tcl_GetStringFromObj(origObjv[i], &elemLen); + if (origObjv[i]->typePtr == &indexType) { + register IndexRep *indexRep = + origObjv[i]->internalRep.otherValuePtr; + + elementStr = EXPAND_OF(indexRep); + elemLen = strlen(elementStr); + } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) { + register EnsembleCmdRep *ecrPtr = + origObjv[i]->internalRep.otherValuePtr; + + elementStr = ecrPtr->fullSubcmdName; + elemLen = strlen(elementStr); + } else { + elementStr = Tcl_GetStringFromObj(origObjv[i], &elemLen); + } len = Tcl_ScanCountedElement(elementStr, elemLen, &flags); if (MAY_QUOTE_WORD && len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp, (unsigned) len); + char *quotedElementStr = TclStackAlloc(interp, (unsigned)len); len = Tcl_ConvertCountedElement(elementStr, elemLen, quotedElementStr, flags); @@ -562,8 +575,14 @@ Tcl_WrongNumArgs( */ if (objv[i]->typePtr == &indexType) { - indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr; + register IndexRep *indexRep = objv[i]->internalRep.otherValuePtr; + Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); + } else if (objv[i]->typePtr == &tclEnsembleCmdType) { + register EnsembleCmdRep *ecrPtr = + objv[i]->internalRep.otherValuePtr; + + Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL); } else { /* * Quote the argument if it contains spaces (Bug 942757). diff --git a/generic/tclInt.h b/generic/tclInt.h index f3c7c5e..8b015b0 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.316 2007/06/10 20:25:55 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.317 2007/06/12 12:29:05 dkf Exp $ */ #ifndef _TCLINT @@ -357,6 +357,27 @@ struct NamespacePathEntry { #define TCL_FIND_ONLY_NS 0x1000 /* + * The data cached in an ensemble subcommand's Tcl_Obj rep (reference in + * otherValuePtr field). This structure is not shared between Tcl_Objs + * referring to the same subcommand, even where one is a duplicate of another. + */ + +typedef struct { + 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. */ + Tcl_Command token; /* Reference to the comamnd for which this + * structure is a cache of the resolution. */ + 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; + +/* *---------------------------------------------------------------- * Data structures related to variables. These are used primarily in tclVar.c *---------------------------------------------------------------- @@ -2195,6 +2216,7 @@ MODULE_SCOPE Tcl_ObjType tclProcBodyType; MODULE_SCOPE Tcl_ObjType tclStringType; MODULE_SCOPE Tcl_ObjType tclArraySearchType; MODULE_SCOPE Tcl_ObjType tclNsNameType; +MODULE_SCOPE Tcl_ObjType tclEnsembleCmdType; #ifndef NO_WIDE_TYPE MODULE_SCOPE Tcl_ObjType tclWideIntType; #endif diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index f674a01..ba64680 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -22,7 +22,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.138 2007/06/11 23:00:44 msofer Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.139 2007/06/12 12:29:06 dkf Exp $ */ #include "tclInt.h" @@ -154,27 +154,6 @@ typedef struct EnsembleConfig { * and on its way out. */ /* - * 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. */ - Tcl_Command token; /* Reference to the comamnd for which this - * structure is a cache of the resolution. */ - 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 functions local to this file: */ @@ -275,7 +254,7 @@ Tcl_ObjType tclNsNameType = { * that implements it. */ -static Tcl_ObjType ensembleCmdType = { +Tcl_ObjType tclEnsembleCmdType = { "ensembleCommand", /* the type's name */ FreeEnsembleCmdRep, /* freeIntRepProc */ DupEnsembleCmdRep, /* dupIntRepProc */ @@ -6152,14 +6131,14 @@ NsEnsembleImplementationCmd( if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) { /* * 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. + * 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 == &ensembleCmdType) { + if (objv[1]->typePtr == &tclEnsembleCmdType) { EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *) - objv[1]->internalRep.otherValuePtr; + objv[1]->internalRep.otherValuePtr; if (ensembleCmd->nsPtr == ensemblePtr->nsPtr && ensembleCmd->epoch == ensemblePtr->epoch && ensembleCmd->token == ensemblePtr->token) { @@ -6179,33 +6158,40 @@ NsEnsembleImplementationCmd( * 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 + * in which it is guaranteed to exist, but we don't do * that (the cacheing of the command object used should - * help with that.) + * help with that.) */ iPtr = (Interp *) interp; - isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL); + isRootEnsemble = + (iPtr->ensembleRewrite.sourceObjs == NULL); copyObj = TclListObjCopy(NULL, prefixObj); - Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); + Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, + &prefixObjv); if (isRootEnsemble) { iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = 2; iPtr->ensembleRewrite.numInsertedObjs = prefixObjc; } else { int ni = iPtr->ensembleRewrite.numInsertedObjs; + if (ni < 2) { iPtr->ensembleRewrite.numRemovedObjs += 2 - ni; - iPtr->ensembleRewrite.numInsertedObjs += prefixObjc - 1; + iPtr->ensembleRewrite.numInsertedObjs += + prefixObjc - 1; } else { - iPtr->ensembleRewrite.numInsertedObjs += prefixObjc - 2; + iPtr->ensembleRewrite.numInsertedObjs += + prefixObjc - 2; } } tempObjv = (Tcl_Obj **) TclStackAlloc(interp, - (int) sizeof(Tcl_Obj *) * (objc - 2 + prefixObjc)); - memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc); - memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2)); + (int) 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, TCL_EVAL_INVOKE); Tcl_DecrRefCount(copyObj); @@ -6475,7 +6461,7 @@ MakeCachedEnsembleCommand( register EnsembleCmdRep *ensembleCmd; int length; - if (objPtr->typePtr == &ensembleCmdType) { + if (objPtr->typePtr == &tclEnsembleCmdType) { ensembleCmd = (EnsembleCmdRep *) objPtr->internalRep.otherValuePtr; Tcl_DecrRefCount(ensembleCmd->realPrefixObj); ensembleCmd->nsPtr->refCount--; @@ -6493,7 +6479,7 @@ MakeCachedEnsembleCommand( TclFreeIntRep(objPtr); ensembleCmd = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep)); objPtr->internalRep.otherValuePtr = (void *) ensembleCmd; - objPtr->typePtr = &ensembleCmdType; + objPtr->typePtr = &tclEnsembleCmdType; } /* @@ -6925,7 +6911,7 @@ DupEnsembleCmdRep( ckalloc(sizeof(EnsembleCmdRep)); int length = strlen(ensembleCmd->fullSubcmdName); - copyPtr->typePtr = &ensembleCmdType; + copyPtr->typePtr = &tclEnsembleCmdType; copyPtr->internalRep.otherValuePtr = (void *) ensembleCopy; ensembleCopy->nsPtr = ensembleCmd->nsPtr; ensembleCopy->epoch = ensembleCmd->epoch; |