diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2004-10-29 15:39:02 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2004-10-29 15:39:02 (GMT) |
commit | f21fa0e01c0fb463b0ec26f3b0cef1218243908a (patch) | |
tree | 0fe2010a58b021f880f03fd319b7dce9e764cd63 /generic | |
parent | 151836cea1737631c005e07ca9a26e7641ff009d (diff) | |
download | tcl-f21fa0e01c0fb463b0ec26f3b0cef1218243908a.zip tcl-f21fa0e01c0fb463b0ec26f3b0cef1218243908a.tar.gz tcl-f21fa0e01c0fb463b0ec26f3b0cef1218243908a.tar.bz2 |
Allow ensembles to rewrite their subcommands' error messages to be more
relevant to users. [Patch 1056864]
Also patches to core to take advantage of this
Also other general cleaning up of Tcl_WrongNumArgs usage
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 15 | ||||
-rw-r--r-- | generic/tclClock.c | 108 | ||||
-rw-r--r-- | generic/tclConfig.c | 8 | ||||
-rw-r--r-- | generic/tclIndexObj.c | 87 | ||||
-rw-r--r-- | generic/tclInt.h | 20 | ||||
-rw-r--r-- | generic/tclNamesp.c | 80 | ||||
-rw-r--r-- | generic/tclProc.c | 52 | ||||
-rw-r--r-- | generic/tclVar.c | 14 |
8 files changed, 263 insertions, 121 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 0102390..2375920 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.133 2004/10/24 22:25:12 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.134 2004/10/29 15:39:04 dkf Exp $ */ #include "tclInt.h" @@ -314,6 +314,14 @@ Tcl_CreateInterp() iPtr->stubTable = &tclStubs; /* + * Initialize the ensemble error message rewriting support. + */ + + iPtr->ensembleRewrite.sourceObjs = NULL; + iPtr->ensembleRewrite.numRemovedObjs = 0; + iPtr->ensembleRewrite.numInsertedObjs = 0; + + /* * TIP#143: Initialise the resource limit support. */ @@ -3031,6 +3039,11 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags) if (flags & TCL_EVAL_GLOBAL) { iPtr->varFramePtr = NULL; } + if (!(flags & TCL_EVAL_INVOKE) && + (iPtr->ensembleRewrite.sourceObjs != NULL) && + !TclIsEnsemble(cmdPtr)) { + iPtr->ensembleRewrite.sourceObjs = NULL; + } code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv); iPtr->varFramePtr = savedVarFramePtr; } diff --git a/generic/tclClock.c b/generic/tclClock.c index 68b7142..ff63767 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -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: tclClock.c,v 1.35 2004/10/21 03:53:04 kennykb Exp $ + * RCS: @(#) $Id: tclClock.c,v 1.36 2004/10/29 15:39:05 dkf Exp $ */ #include "tclInt.h" @@ -336,7 +336,6 @@ TclClockMktimeObjCmd( ClientData clientData, } - /*---------------------------------------------------------------------- * * TclClockClicksObjCmd -- @@ -356,7 +355,7 @@ TclClockMktimeObjCmd( ClientData clientData, */ int -TclClockClicksObjCmd( clientData, interp, objc, objv ) +TclClockClicksObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Client data is unused */ Tcl_Interp* interp; /* Tcl interpreter */ int objc; /* Parameter count */ @@ -371,46 +370,43 @@ TclClockClicksObjCmd( clientData, interp, objc, objv ) int index = CLICKS_NATIVE; Tcl_Time now; - switch ( objc ) { - case 1: - break; - case 2: - if ( Tcl_GetIndexFromObj( interp, objv[1], clicksSwitches, - "option", 0, &index) != TCL_OK ) { - return TCL_ERROR; - } - break; - default: - Tcl_WrongNumArgs( interp, 1, objv, "?option?" ); + switch (objc) { + case 1: + break; + case 2: + if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0, + &index) != TCL_OK) { return TCL_ERROR; + } + break; + default: + Tcl_WrongNumArgs(interp, 1, objv, "?option?"); + return TCL_ERROR; } - switch ( index ) { - case CLICKS_MILLIS: - Tcl_GetTime( &now ); - Tcl_SetObjResult( interp, - Tcl_NewWideIntObj( (Tcl_WideInt) now.sec * 1000 - + now.usec / 1000 ) ); - break; - case CLICKS_NATIVE: + switch (index) { + case CLICKS_MILLIS: + Tcl_GetTime(&now); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt) + now.sec * 1000 + now.usec / 1000 ) ); + break; + case CLICKS_NATIVE: #if 0 - /* - * The following code will be used once this is incorporated - * into Tcl. But TEA bugs prevent it for right now. :( - * So we fall through this case and return the microseconds - * instead. - */ - Tcl_SetObjResult( interp, - Tcl_NewWideIntObj( (Tcl_WideInt) TclpGetClicks() ) ); - break; + /* + * The following code will be used once this is incorporated + * into Tcl. But TEA bugs prevent it for right now. :( + * So we fall through this case and return the microseconds + * instead. + */ + Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt) + TclpGetClicks())); + break; #endif - case CLICKS_MICROS: - Tcl_GetTime( &now ); - Tcl_SetObjResult( interp, - Tcl_NewWideIntObj( ( (Tcl_WideInt) now.sec - * 1000000 ) - + now.usec ) ); - break; + case CLICKS_MICROS: + Tcl_GetTime(&now); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj( + ((Tcl_WideInt) now.sec * 1000000) + now.usec)); + break; } return TCL_OK; @@ -435,21 +431,20 @@ TclClockClicksObjCmd( clientData, interp, objc, objv ) */ int -TclClockMillisecondsObjCmd( clientData, interp, objc, objv ) +TclClockMillisecondsObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Client data is unused */ Tcl_Interp* interp; /* Tcl interpreter */ int objc; /* Parameter count */ Tcl_Obj* CONST* objv; /* Parameter values */ { Tcl_Time now; - if ( objc != 1 ) { - Tcl_WrongNumArgs( interp, 1, objv, "" ); + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - Tcl_GetTime( &now ); - Tcl_SetObjResult( interp, - Tcl_NewWideIntObj( (Tcl_WideInt) now.sec * 1000 - + now.usec / 1000 ) ); + Tcl_GetTime(&now); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt) + now.sec * 1000 + now.usec / 1000)); return TCL_OK; } @@ -472,21 +467,20 @@ TclClockMillisecondsObjCmd( clientData, interp, objc, objv ) */ int -TclClockMicrosecondsObjCmd( clientData, interp, objc, objv ) +TclClockMicrosecondsObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Client data is unused */ Tcl_Interp* interp; /* Tcl interpreter */ int objc; /* Parameter count */ Tcl_Obj* CONST* objv; /* Parameter values */ { Tcl_Time now; - if ( objc != 1 ) { - Tcl_WrongNumArgs( interp, 1, objv, "" ); + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - Tcl_GetTime( &now ); - Tcl_SetObjResult( interp, - Tcl_NewWideIntObj( ( (Tcl_WideInt) now.sec * 1000000 ) - + now.usec ) ); + Tcl_GetTime(&now); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj( + ((Tcl_WideInt) now.sec * 1000000) + now.usec)); return TCL_OK; } @@ -509,19 +503,19 @@ TclClockMicrosecondsObjCmd( clientData, interp, objc, objv ) */ int -TclClockSecondsObjCmd( clientData, interp, objc, objv ) +TclClockSecondsObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Client data is unused */ Tcl_Interp* interp; /* Tcl interpreter */ int objc; /* Parameter count */ Tcl_Obj* CONST* objv; /* Parameter values */ { Tcl_Time now; - if ( objc != 1 ) { - Tcl_WrongNumArgs( interp, 1, objv, "" ); + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - Tcl_GetTime( &now ); - Tcl_SetObjResult( interp, Tcl_NewWideIntObj( (Tcl_WideInt) now.sec ) ); + Tcl_GetTime(&now); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec)); return TCL_OK; } diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 3cd5813..4daf92f 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclConfig.c,v 1.5 2003/12/24 04:18:19 davygrvy Exp $ + * RCS: @(#) $Id: tclConfig.c,v 1.6 2004/10/29 15:39:05 dkf Exp $ */ #include "tclInt.h" @@ -209,7 +209,7 @@ QueryConfigObjCmd(clientData, interp, objc, objv) }; if ((objc < 2) || (objc > 3)) { - Tcl_WrongNumArgs (interp, 0, NULL, "list | get key"); + Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings, @@ -228,7 +228,7 @@ QueryConfigObjCmd(clientData, interp, objc, objv) switch ((enum subcmds) index) { case CFG_GET: if (objc != 3) { - Tcl_WrongNumArgs(interp, 0, NULL, "get key"); + Tcl_WrongNumArgs(interp, 1, objv, "get key"); return TCL_ERROR; } @@ -243,7 +243,7 @@ QueryConfigObjCmd(clientData, interp, objc, objv) case CFG_LIST: if (objc != 2) { - Tcl_WrongNumArgs(interp, 0, NULL, "list"); + Tcl_WrongNumArgs(interp, 1, objv, "list"); return TCL_ERROR; } diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 22397af..cd4dc44 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.20 2004/10/06 14:59:02 dgp Exp $ + * RCS: @(#) $Id: tclIndexObj.c,v 1.21 2004/10/29 15:39:05 dkf Exp $ */ #include "tclInt.h" @@ -445,12 +445,69 @@ Tcl_WrongNumArgs(interp, objc, objv, message) * message may be NULL. */ { Tcl_Obj *objPtr; - int i; + int i, len, elemLen, flags; register IndexRep *indexRep; + Interp *iPtr = (Interp *) interp; + char *elementStr; TclNewObj(objPtr); - Tcl_SetObjResult(interp, objPtr); Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1); + + /* + * Check to see if we are processing an ensemble implementation, + * and if so rewrite the results in terms of how the ensemble was + * invoked. + */ + + if (iPtr->ensembleRewrite.sourceObjs != NULL) { + /* + * We only know how to do rewriting if all the replaced + * objects are actually arguments (in objv) to this function. + * Otherwise it just gets too complicated... + */ + + if (objc >= iPtr->ensembleRewrite.numInsertedObjs) { + objv += iPtr->ensembleRewrite.numInsertedObjs; + objc -= iPtr->ensembleRewrite.numInsertedObjs; + /* + * We assume no object is of index type. + */ + for (i=0 ; i<iPtr->ensembleRewrite.numRemovedObjs ; i++) { + /* + * Add the element, quoting it if necessary. + */ + + elementStr = Tcl_GetStringFromObj( + iPtr->ensembleRewrite.sourceObjs[i], &elemLen); + len = Tcl_ScanCountedElement(elementStr, elemLen, &flags); + if (len != elemLen) { + char *quotedElementStr = ckalloc((unsigned) len); + len = Tcl_ConvertCountedElement(elementStr, elemLen, + quotedElementStr, flags); + Tcl_AppendToObj(objPtr, quotedElementStr, len); + ckfree(quotedElementStr); + } else { + Tcl_AppendToObj(objPtr, elementStr, elemLen); + } + + /* + * Add a space if the word is not the last one (which + * has a moderately complex condition here). + */ + + if ((i < (iPtr->ensembleRewrite.numRemovedObjs - 1)) + || objc || message) { + Tcl_AppendStringsToObj(objPtr, " ", (char *) NULL); + } + } + } + } + + /* + * Now add the arguments (other than those rewritten) that the + * caller took from its calling context. + */ + for (i = 0; i < objc; i++) { /* * If the object is an index type use the index table which allows @@ -462,8 +519,21 @@ Tcl_WrongNumArgs(interp, objc, objv, message) indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *) NULL); } else { - Tcl_AppendStringsToObj(objPtr, Tcl_GetString(objv[i]), - (char *) NULL); + /* + * Quote the argument if it contains spaces (Bug 942757). + */ + + elementStr = Tcl_GetStringFromObj(objv[i], &elemLen); + len = Tcl_ScanCountedElement(elementStr, elemLen, &flags); + if (len != elemLen) { + char *quotedElementStr = ckalloc((unsigned) len); + len = Tcl_ConvertCountedElement(elementStr, elemLen, + quotedElementStr, flags); + Tcl_AppendToObj(objPtr, quotedElementStr, len); + ckfree(quotedElementStr); + } else { + Tcl_AppendToObj(objPtr, elementStr, elemLen); + } } /* @@ -475,8 +545,15 @@ Tcl_WrongNumArgs(interp, objc, objv, message) } } + /* + * Add any trailing message bits and set the resulting string as + * the interpreter result. Caller is responsible for reporting + * this as an actual error. + */ + if (message) { Tcl_AppendStringsToObj(objPtr, message, (char *) NULL); } Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL); + Tcl_SetObjResult(interp, objPtr); } diff --git a/generic/tclInt.h b/generic/tclInt.h index ca5727c..c4182db 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.189 2004/10/27 17:13:58 davygrvy Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.190 2004/10/29 15:39:05 dkf Exp $ */ #ifndef _TCLINT @@ -1400,6 +1400,23 @@ typedef struct Interp { } limit; /* + * Information for improved default error generation from + * ensembles (TIP#112). + */ + + struct { + Tcl_Obj * CONST *sourceObjs; + /* What arguments were actually input into + * the *root* ensemble command? (Nested + * ensembles don't rewrite this.) NULL if + * we're not processing an ensemble. */ + int numRemovedObjs; /* How many arguments have been stripped off + * because of ensemble processing. */ + int numInsertedObjs; /* How many of the current arguments were + * inserted by an ensemble. */ + } ensembleRewrite; + + /* * Statistical information about the bytecode compiler and interpreter's * operation. */ @@ -1949,6 +1966,7 @@ EXTERN int TclpDlopen _ANSI_ARGS_((Tcl_Interp *interp, Tcl_FSUnloadFileProc **unloadProcPtr)); EXTERN int TclpUtime _ANSI_ARGS_((Tcl_Obj *pathPtr, struct utimbuf *tval)); +EXTERN int TclIsEnsemble _ANSI_ARGS_((Command *cmdPtr)); /* *---------------------------------------------------------------- diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 38c5dd7..34faf71 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -21,7 +21,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.63 2004/10/22 15:46:37 dkf Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.64 2004/10/29 15:39:06 dkf Exp $ */ #include "tclInt.h" @@ -3367,8 +3367,7 @@ NamespaceExportCmd(dummy, interp, objc, objv) int firstArg, patternCt, i, result; if (objc < 2) { - Tcl_WrongNumArgs(interp, 2, objv, - "?-clear? ?pattern pattern...?"); + Tcl_WrongNumArgs(interp, 2, objv, "?-clear? ?pattern pattern...?"); return TCL_ERROR; } @@ -3526,8 +3525,7 @@ NamespaceImportCmd(dummy, interp, objc, objv) int firstArg; if (objc < 2) { - Tcl_WrongNumArgs(interp, 2, objv, - "?-force? ?pattern pattern...?"); + Tcl_WrongNumArgs(interp, 2, objv, "?-force? ?pattern pattern...?"); return TCL_ERROR; } @@ -4863,6 +4861,37 @@ FindEnsemble(interp, cmdNameObj, flags) /* *---------------------------------------------------------------------- * + * TclIsEnsemble -- + * + * Simple test for ensemble-hood that takes into account imported + * ensemble commands as well. + * + * Results: + * Boolean value + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +int +TclIsEnsemble(cmdPtr) + Command *cmdPtr; +{ + if (cmdPtr->objProc == NsEnsembleImplementationCmd) { + return 1; + } + cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr); + if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) { + return 0; + } + return 1; +} + +/* + *---------------------------------------------------------------------- + * * NsEnsembleImplementationCmd -- * * Implements an ensemble of commands (being those exported by a @@ -5045,15 +5074,38 @@ NsEnsembleImplementationCmd(clientData, interp, objc, objv) Tcl_IncrRefCount(prefixObj); runResultingSubcommand: - 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, - TCL_EVAL_INVOKE); - Tcl_DecrRefCount(prefixObj); - ckfree((char *)tempObjv); - return result; + { + Interp *iPtr = (Interp *) interp; + int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL); + + Tcl_ListObjGetElements(NULL, prefixObj, &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; + } else { + iPtr->ensembleRewrite.numInsertedObjs += prefixObjc - 2; + } + } + 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, + TCL_EVAL_INVOKE); + Tcl_DecrRefCount(prefixObj); + ckfree((char *)tempObjv); + if (isRootEnsemble) { + iPtr->ensembleRewrite.sourceObjs = NULL; + iPtr->ensembleRewrite.numRemovedObjs = 0; + iPtr->ensembleRewrite.numInsertedObjs = 0; + } + return result; + } unknownOrAmbiguousSubcommand: /* diff --git a/generic/tclProc.c b/generic/tclProc.c index d35ba32..adca38d 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.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: tclProc.c,v 1.63 2004/10/22 13:48:58 dkf Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.64 2004/10/29 15:39:06 dkf Exp $ */ #include "tclInt.h" @@ -1043,47 +1043,39 @@ TclObjInterpProc(clientData, interp, objc, objv) localPtr = localPtr->nextPtr; } if (argCt > 0) { - Tcl_Obj *objResult; - int len, flags; + Tcl_Obj **desiredObjs, *argObj; - incorrectArgs: + incorrectArgs: /* - * Build up equivalent to Tcl_WrongNumArgs message for proc + * Build up desired argument list for Tcl_WrongNumArgs */ - Tcl_ResetResult(interp); - TclNewObj(objResult); - Tcl_AppendToObj(objResult, "wrong # args: should be \"", -1); - - /* - * Quote the proc name if it contains spaces (Bug 942757). - */ - - len = Tcl_ScanCountedElement(procName, nameLen, &flags); - if (len != nameLen) { - char *procName1 = ckalloc((unsigned) len); - len = Tcl_ConvertCountedElement(procName, nameLen, procName1, flags); - Tcl_AppendToObj(objResult, procName1, len); - ckfree(procName1); - } else { - Tcl_AppendToObj(objResult, procName, len); - } - + desiredObjs = (Tcl_Obj **) + ckalloc(sizeof(Tcl_Obj *) * (unsigned)(numArgs+1)); + desiredObjs[0] = objv[0]; localPtr = procPtr->firstLocalPtr; - for (i = 1; i <= numArgs; i++) { + for (i=1 ; i<=numArgs ; i++) { + TclNewObj(argObj); if (localPtr->defValuePtr != NULL) { - Tcl_AppendStringsToObj(objResult, - " ?", localPtr->name, "?", (char *) NULL); + Tcl_AppendStringsToObj(argObj, + "?", localPtr->name, "?", (char *) NULL); + } else if ((i==numArgs) && (strcmp(localPtr->name, "args")==0)) { + Tcl_AppendStringsToObj(argObj, "...", (char *) NULL); } else { - Tcl_AppendStringsToObj(objResult, - " ", localPtr->name, (char *) NULL); + Tcl_AppendStringsToObj(argObj, localPtr->name, (char *) NULL); } + desiredObjs[i] = argObj; localPtr = localPtr->nextPtr; } - Tcl_AppendStringsToObj(objResult, "\"", (char *) NULL); - Tcl_SetObjResult(interp, objResult); + Tcl_ResetResult(interp); + Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, NULL); result = TCL_ERROR; + + for (i=1 ; i<=numArgs ; i++) { + TclDecrRefCount(desiredObjs[i]); + } + ckfree((char *) desiredObjs); goto procDone; } diff --git a/generic/tclVar.c b/generic/tclVar.c index 7dc0bfe..6162fc3 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.97 2004/10/26 16:19:58 msofer Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.98 2004/10/29 15:39:06 dkf Exp $ */ #ifdef STDC_HEADERS @@ -2729,8 +2729,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) ArraySearch *searchPtr; if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, - "arrayName searchId"); + Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); return TCL_ERROR; } if (notArray) { @@ -2762,8 +2761,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) ArraySearch *searchPtr, *prevPtr; if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, - "arrayName searchId"); + Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); return TCL_ERROR; } if (notArray) { @@ -2914,8 +2912,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) mode = OPT_GLOB; if ((objc < 3) || (objc > 5)) { - Tcl_WrongNumArgs(interp, 2, objv, - "arrayName ?mode? ?pattern?"); + Tcl_WrongNumArgs(interp, 2,objv, "arrayName ?mode? ?pattern?"); return TCL_ERROR; } if (notArray) { @@ -2975,8 +2972,7 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) Tcl_HashEntry *hPtr; if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, - "arrayName searchId"); + Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId"); return TCL_ERROR; } if (notArray) { |