diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2007-06-12 12:29:03 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2007-06-12 12:29:03 (GMT) |
commit | bf56a09707e69cf1c2ca8a5cec6617c0dca24d57 (patch) | |
tree | 77dcc03631a20a577c5de5bd77c2012af285e413 /generic | |
parent | 8dd53a8ad1790646d8c1a51fba684de5b75a4321 (diff) | |
download | tcl-bf56a09707e69cf1c2ca8a5cec6617c0dca24d57.zip tcl-bf56a09707e69cf1c2ca8a5cec6617c0dca24d57.tar.gz tcl-bf56a09707e69cf1c2ca8a5cec6617c0dca24d57.tar.bz2 |
Improve the argument substitution behaviour of Tcl_WrongNumArgs when faced with
ensemble and interp-alias rewrites.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclIndexObj.c | 29 | ||||
-rw-r--r-- | generic/tclInt.h | 24 | ||||
-rw-r--r-- | generic/tclNamesp.c | 66 |
3 files changed, 73 insertions, 46 deletions
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; |