Index: doc/proc.n ================================================================== --- doc/proc.n +++ doc/proc.n @@ -36,10 +36,19 @@ Arguments with default values that are followed by non-defaulted arguments become required arguments; enough actual arguments must be supplied to allow all arguments up to and including the last required formal argument. .PP +If the \fIargs\fR is the last formal argument, and it is given a default +value, that default value is interpreted to be the specification for +how named parameters beyond the last formal argument will be interpreted +(an argspec). An argspec is a dict where every key calls out a local variable +to be defined. The values are a dict which can contain one or more of the +following options: default (a default value), mandatory (boolean, when false +an error will not be thrown if the parameter is missing), and aliases (a +list of alternative names for this parameter.) +.PP When \fIname\fR is invoked a local variable will be created for each of the formal arguments to the procedure; its value will be the value of corresponding argument in the invoking command or the argument's default value. Actual arguments are assigned to formal arguments strictly in order. @@ -59,10 +68,18 @@ then a call to the procedure may contain more actual arguments than the procedure has formal arguments. In this case, all of the actual arguments starting at the one that would be assigned to \fBargs\fR are combined into a list (as if the \fBlist\fR command had been used); this combined value is assigned to the local variable \fBargs\fR. +.PP +When an argspec is defined elements beyond the last formal +argument are a dict. A variable with the name of every field will be +fill with the contents of every value. An argspec can provide a default value +for missing named parameters, or state that parameter is non-mandatory. +Non-mandatory fields will not be mapped as local variables. The value of +\fIargs\fR is still a verbatim record of elements beyond the final formal +argument. .PP When \fIbody\fR is being executed, variable names normally refer to local variables, which are created automatically when referenced and deleted when the procedure returns. One local variable is automatically created for each of the procedure's arguments. Index: generic/tcl.decls ================================================================== --- generic/tcl.decls +++ generic/tcl.decls @@ -2332,12 +2332,10 @@ const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData) } # ----- BASELINE -- FOR -- 8.7.0 ----- # - - ############################################################################## # Define the platform specific public Tcl interface. These functions are only # available on the designated platform. Index: generic/tclBasic.c ================================================================== --- generic/tclBasic.c +++ generic/tclBasic.c @@ -198,10 +198,11 @@ static const CmdInfo builtInCmds[] = { /* * Commands in the generic core. */ + {"argsx", Tcl_ArgsxObjCmd, NULL, NULL, CMD_IS_SAFE}, {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, #ifndef TCL_NO_DEPRECATED {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, @@ -819,10 +820,14 @@ * Tcl_CreateObjCommand, since they aren't in the global namespace and * involve ensembles. */ TclClockInit(interp); + + /* Tip 479 - Register literals for the argsx command */ + TclProcInit(interp); + /* * Register the built-in functions. This is empty now that they are * implemented as commands in the ::tcl::mathfunc namespace. */ @@ -7720,11 +7725,11 @@ if (!(iPtr->flags & RAND_SEED_INITIALIZED)) { iPtr->flags |= RAND_SEED_INITIALIZED; /* - * To ensure different seeds in different threads (bug #416643), + * To ensure different seeds in different threads (bug #416643), * take into consideration the thread this interp is running in. */ iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12); Index: generic/tclCmdIL.c ================================================================== --- generic/tclCmdIL.c +++ generic/tclCmdIL.c @@ -106,10 +106,12 @@ static int DictionaryCompare(const char *left, const char *right); static Tcl_NRPostProc IfConditionCallback; static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int InfoArgSpecCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static int InfoBodyCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp, @@ -159,10 +161,11 @@ * "info" command. */ static const EnsembleImplMap defaultInfoMap[] = { {"args", InfoArgsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"argspec", InfoArgSpecCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"body", InfoBodyCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"cmdcount", InfoCmdCountCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0}, {"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0}, @@ -512,10 +515,76 @@ } } Tcl_SetObjResult(interp, listObjPtr); return TCL_OK; } + +/* + *---------------------------------------------------------------------- + * + * InfoArgspecCmd -- + * + * Called to implement the "info argspec" command that returns the argument + * list for a procedure. Handles the following syntax: + * + * info argspec procName + * + * Results: + * Returns TCL_OK if successful and TCL_ERROR if there is an error. + * + * Side effects: + * Returns a result in the interpreter's result object. If there is an + * error, the result is an error message. + * + *---------------------------------------------------------------------- + */ + +static int +InfoArgSpecCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + register Interp *iPtr = (Interp *) interp; + const char *name; + Proc *procPtr; + CompiledLocal *localPtr; + Tcl_Obj *resultObjPtr=NULL; + + if (objc != 1 && objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "procname"); + return TCL_ERROR; + } + if(objc==2) { + name = TclGetString(objv[1]); + procPtr = TclFindProc(iPtr, name); + } else { + procPtr = iPtr->framePtr->procPtr; + } + if (procPtr == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't a procedure", name)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL); + return TCL_ERROR; + } + + /* + * Build a return list containing the arguments. + */ + + for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; + localPtr = localPtr->nextPtr) { + if (localPtr->flags & VAR_IS_ARGS) { + if(localPtr->defValuePtr) { + Tcl_IncrRefCount(localPtr->defValuePtr); + Tcl_SetObjResult(interp, localPtr->defValuePtr); + } + } + } + return TCL_OK; +} /* *---------------------------------------------------------------------- * * InfoBodyCmd -- Index: generic/tclInt.h ================================================================== --- generic/tclInt.h +++ generic/tclInt.h @@ -737,10 +737,11 @@ /* Special handling on initialisation (only CompiledLocal). */ #define VAR_ARGUMENT 0x100 /* KEEP OLD VALUE! See tclProc.c */ #define VAR_TEMPORARY 0x200 /* KEEP OLD VALUE! See tclProc.c */ #define VAR_IS_ARGS 0x400 #define VAR_RESOLVED 0x8000 +#define VAR_NAMED_ARGUMENT 0x10000 /* * Macros to ensure that various flag bits are set properly for variables. * The ANSI C "prototypes" for these macros are: * @@ -3281,10 +3282,15 @@ MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr, int pathc, Tcl_Obj *const pathv[]); MODULE_SCOPE int Tcl_DisassembleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +/* Tip 479 */ +MODULE_SCOPE int TclProcInit(Tcl_Interp *interp); +MODULE_SCOPE int Tcl_ArgsxObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); /* Assemble command function */ MODULE_SCOPE int Tcl_AssembleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); Index: generic/tclProc.c ================================================================== --- generic/tclProc.c +++ generic/tclProc.c @@ -45,10 +45,11 @@ static void MakeProcError(Tcl_Interp *interp, Tcl_Obj *procNameObj); static void MakeLambdaError(Tcl_Interp *interp, Tcl_Obj *procNameObj); static int SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static int ProcEatArgs(Tcl_Interp *interp,CallFrame *framePtr,Tcl_Obj *argspec,Tcl_Obj *values); static Tcl_NRPostProc ApplyNR2; static Tcl_NRPostProc InterpProcNR2; static Tcl_NRPostProc Uplevel_Callback; @@ -94,10 +95,237 @@ FreeLambdaInternalRep, /* freeIntRepProc */ DupLambdaInternalRep, /* dupIntRepProc */ NULL, /* updateStringProc */ SetLambdaFromAny /* setFromAnyProc */ }; + +/* Literal Pool */ +static Tcl_Obj *obj_const_aliases; +static Tcl_Obj *obj_const_args; +static Tcl_Obj *obj_const_default; +static Tcl_Obj *obj_const_mandatory; +static Tcl_Obj *obj_const_atspec; + +int TclProcInit(Tcl_Interp *interp) { + static int once=0; + if(!once) { + obj_const_aliases=Tcl_NewStringObj("aliases:",-1); + Tcl_IncrRefCount(obj_const_aliases); + obj_const_args=Tcl_NewStringObj("args",-1); + Tcl_IncrRefCount(obj_const_args); + obj_const_default=Tcl_NewStringObj("default:",-1); + Tcl_IncrRefCount(obj_const_default); + obj_const_mandatory=Tcl_NewStringObj("mandatory:",-1); + Tcl_IncrRefCount(obj_const_mandatory); + obj_const_atspec=Tcl_NewStringObj("argspec",-1); + Tcl_IncrRefCount(obj_const_atspec); + once=1; + } + return TCL_OK; +} + +/* +** Code to support TIP 479 +*/ + +/* +** TIP 479 +** A simplified TclLookupSimpleVar +*/ +/* + * NOTE: VarHashCreateVar increments the recount of its key argument. + * All callers that will call Tcl_DecrRefCount on that argument must + * call Tcl_IncrRefCount on it before passing it in. This requirement + * can bubble up to callers of callers .... etc. + */ +#define VarHashGetValue(hPtr) \ + ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) + +static inline Var * +VarHashCreateVar( + TclVarHashTable *tablePtr, + Tcl_Obj *key, + int *newPtr) +{ + Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table, key, newPtr); + + if (hPtr) { + return VarHashGetValue(hPtr); + } else { + return NULL; + } +} + +void ProcSetLocalVar ( + CallFrame *framePtr, + Tcl_Obj *varNamePtr, /* Scaler name */ + Tcl_Obj *valuePtr /* Value to set */ +) { + int i, varLen, idx, isNew; + const char *varName = TclGetStringFromObj(varNamePtr, &varLen); + int localLen, localCt = framePtr->numCompiledLocals; + Tcl_Obj **objPtrPtr = &framePtr->localCachePtr->varName0; + const char *localNameStr; + TclVarHashTable *tablePtr; /* Points to the hashtable, if any, in which + * to look up the variable. */ + Var *varPtr; /* Points to the Var structure returned for + * the variable. */ + varPtr = NULL; + idx=-1; + isNew=-1; + for (i=0 ; icompiledLocals[i]; + break; + } + } + } + if(!varPtr) { + tablePtr = framePtr->varTablePtr; + if (tablePtr == NULL) { + tablePtr = ckalloc(sizeof(TclVarHashTable)); + TclInitVarHashTable(tablePtr, NULL); + framePtr->varTablePtr = tablePtr; + } + varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew); + } + varPtr->flags=VAR_NAMED_ARGUMENT; + varPtr->value.objPtr=valuePtr; + Tcl_IncrRefCount(valuePtr); +} + +int ProcEatArgs( + Tcl_Interp *interp, + CallFrame *framePtr, + Tcl_Obj *argspec, + Tcl_Obj *argsValuePtr +) { + Tcl_DictSearch search; + Tcl_Obj *fieldname, *fieldspec; + int done=0; + int isNew=0,idx=-1; + if (Tcl_DictObjFirst(interp, argspec, &search, + &fieldname, &fieldspec, &done) != TCL_OK) { + return TCL_ERROR; + } + for (; !done ; Tcl_DictObjNext(&search, &fieldname, &fieldspec, &done)) { + Tcl_Obj *iVal; + Tcl_Obj *aliases,*defaultObj,*mandatoryObj; + int mandatory=1; + + if(Tcl_DictObjGet(interp,argsValuePtr,fieldname,&iVal)!=TCL_OK) return TCL_ERROR; + if(iVal) { + ProcSetLocalVar(framePtr,fieldname,iVal); + continue; + } + /* Fight for another day - Look through the aliases */ + if(Tcl_DictObjGet(interp,fieldspec,obj_const_aliases,&aliases)!=TCL_OK) return TCL_ERROR; + if(aliases) { + Tcl_Obj **varv; + int varc,vargi; + if (Tcl_ListObjGetElements(interp, aliases, &varc, &varv) != TCL_OK) return TCL_ERROR; + for(vargi=0;vargi procPtr->numArgs) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -656,13 +884,69 @@ if ((i == numArgs - 1) && (localPtr->nameLength == 4) && (localPtr->name[0] == 'a') && (strcmp(localPtr->name, "args") == 0)) { localPtr->flags |= VAR_IS_ARGS; + if(fieldCount == 2) { + /* + ** TIP 479 + ** Use the otherwise ignored default field for the last + ** parameter named args as a dict-based specification for + ** named parameters + */ + Tcl_DictSearch search; + Tcl_Obj *fieldname, *fieldspec; + int done=0; + char *Fieldname; + int FieldLen; + Tcl_Obj *argspec; + + /* + ** Create entries in runtime procedure frame's array for + ** each named parameter + */ + argspec=localPtr->defValuePtr; + if(Tcl_DictObjFirst(NULL, argspec, &search,&fieldname, &fieldspec, &done) != TCL_OK) goto procError; + + for (; !done ; Tcl_DictObjNext(&search, &fieldname, &fieldspec, &done)) { + /* Allocate one slot for each of the other named parameters */ + Tcl_Obj *defaultObj,*mandatoryObj; + int mandatory=1; + + defaultObj=NULL; + mandatoryObj=NULL; + Tcl_DictObjGet(NULL,fieldspec,obj_const_default,&defaultObj); + Tcl_DictObjGet(NULL,fieldspec,obj_const_mandatory,&mandatoryObj); + if(mandatoryObj) { + if(Tcl_GetBooleanFromObj(interp,mandatoryObj,&mandatory)) { + mandatory=1; + } + } + /* Non-mandatory fields are not tracked */ + if(!defaultObj && !mandatory) continue; + + procPtr->numCompiledLocals++; + Fieldname=Tcl_GetStringFromObj(fieldname,&FieldLen); + localPtr = ckalloc(TclOffset(CompiledLocal, name) + FieldLen+1); + procPtr->lastLocalPtr->nextPtr = localPtr; + procPtr->lastLocalPtr = localPtr; + memcpy(localPtr->name, Fieldname, FieldLen + 1); + localPtr->nextPtr = NULL; + localPtr->nameLength = FieldLen; + localPtr->frameIndex = i; + localPtr->flags = VAR_NAMED_ARGUMENT; + localPtr->resolveInfo = NULL; + if(defaultObj) { + localPtr->defValuePtr=defaultObj; + Tcl_IncrRefCount(localPtr->defValuePtr); + } else { + localPtr->defValuePtr=NULL; + } + } + } } } - ckfree(fieldValues); } *procPtrPtr = procPtr; ckfree(argArray); @@ -1152,11 +1436,10 @@ Namespace *nsPtr) /* Pointer to current namespace. */ { Var *varPtr = framePtr->compiledLocals; Tcl_Obj *bodyPtr; ByteCode *codePtr; - bodyPtr = framePtr->procPtr->bodyPtr; if (bodyPtr->typePtr != &tclByteCodeType) { Tcl_Panic("body object for proc attached to frame is not a byte code type"); } codePtr = bodyPtr->internalRep.twoPtrValue.ptr1; @@ -1166,11 +1449,10 @@ InitLocalCache(framePtr->procPtr) ; } framePtr->localCachePtr = codePtr->localCachePtr; framePtr->localCachePtr->refCount++; } - InitResolvedLocals(interp, codePtr, varPtr, nsPtr); } /* *---------------------------------------------------------------------- @@ -1200,11 +1482,10 @@ Interp *iPtr = (Interp *) interp; int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr); CompiledLocal *firstLocalPtr, *localPtr; int varNum; Tcl_ResolvedVarInfo *resVarInfo; - /* * Find the localPtr corresponding to varPtr */ varNum = varPtr - iPtr->framePtr->compiledLocals; @@ -1233,11 +1514,11 @@ localPtr->resolveInfo = NULL; } localPtr->flags &= ~VAR_RESOLVED; if (haveResolvers && - !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) { + !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY|VAR_NAMED_ARGUMENT))) { ResolverScheme *resPtr = iPtr->resolverPtr; Tcl_ResolvedVarInfo *vinfo; int result; if (nsPtr->compiledVarResProc) { @@ -1352,11 +1633,10 @@ *namePtr = TclCreateLiteral(iPtr, localPtr->name, localPtr->nameLength, /* hash */ (unsigned int) -1, &new, /* nsPtr */ NULL, 0, NULL); Tcl_IncrRefCount(*namePtr); } - if (i < numArgs) { varPtr->flags = (localPtr->flags & VAR_IS_ARGS); varPtr->value.objPtr = localPtr->defValuePtr; varPtr++; i++; @@ -1401,16 +1681,15 @@ register Proc *procPtr = framePtr->procPtr; ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; register Var *varPtr, *defPtr; int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax; Tcl_Obj *const *argObjs; - + Tcl_Obj *argSpec=NULL,*argsValuePtr=NULL; /* * Make sure that the local cache of variable names and initial values has * been initialised properly . */ - if (localCt) { if (!codePtr->localCachePtr) { InitLocalCache(procPtr) ; } framePtr->localCachePtr = codePtr->localCachePtr; @@ -1423,11 +1702,10 @@ /* * Create the "compiledLocals" array. Make sure it is large enough to hold * all the procedure's compiled local variables, including its formal * parameters. */ - varPtr = TclStackAlloc(interp, (int)(localCt * sizeof(Var))); framePtr->compiledLocals = varPtr; framePtr->numCompiledLocals = localCt; /* @@ -1482,14 +1760,19 @@ * defPtr and varPtr point to the last argument to be initialized. */ varPtr->flags = 0; if (defPtr && defPtr->flags & VAR_IS_ARGS) { - Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i); - - varPtr->value.objPtr = listPtr; - Tcl_IncrRefCount(listPtr); /* Local var is a reference. */ + /* + ** Build a conventional list of arguments + ** past the last positional argument, and call it + ** args + */ + argsValuePtr = Tcl_NewListObj(argCt-i, argObjs+i); + varPtr->value.objPtr = argsValuePtr; + argSpec=defPtr->value.objPtr; + Tcl_IncrRefCount(argsValuePtr); /* Local var is a reference. */ } else if (argCt == numArgs) { Tcl_Obj *objPtr = argObjs[i]; varPtr->value.objPtr = objPtr; Tcl_IncrRefCount(objPtr); /* Local var is a reference. */ @@ -1515,11 +1798,20 @@ memset(varPtr, 0, (localCt - numArgs)*sizeof(Var)); } else { InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr); } } - + if(argSpec) { + /* + ** TIP 479 + ** Feed dict values into compiled locals + ** If a required parameter is missing ProcEatArgs + ** will return TCL_ERROR. + */ + if(ProcEatArgs(interp,framePtr,argSpec,argsValuePtr) + != TCL_OK) goto incorrectArgs; + } return TCL_OK; /* * Initialise all compiled locals to avoid problems at DeleteLocalVars. */ @@ -1991,11 +2283,10 @@ * namespace context, so that the byte codes are compiled in the * appropriate class context. */ iPtr->compiledProcPtr = procPtr; - if (procPtr->numCompiledLocals > procPtr->numArgs) { CompiledLocal *clPtr = procPtr->firstLocalPtr; CompiledLocal *lastPtr = NULL; int i, numArgs = procPtr->numArgs; @@ -2023,11 +2314,10 @@ } ckfree(toFree); } procPtr->numCompiledLocals = procPtr->numArgs; } - (void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr, /* isProcCallFrame */ 0); /* * TIP #280: We get the invoking context from the cmdFrame which Index: library/init.tcl ================================================================== --- library/init.tcl +++ library/init.tcl @@ -834,5 +834,11 @@ file copy -force -- $s [file join $dest [file tail $s]] } } return } + +proc procx {name argspec body} { proc $name [list [list args $argspec]] $body } +proc ::oo::define::methodx {name argspec body} { + set class [lindex [::info level -1] 1] + oo::define $class method $name [list [list args $argspec]] $body +} Index: tests/proc.test ================================================================== --- tests/proc.test +++ tests/proc.test @@ -381,14 +381,116 @@ interp create slave slave eval [list apply $lambda foo] interp delete slave unset lambda } {} + # cleanup catch {rename p ""} catch {rename t ""} + + +test proc-8.0 {Named parameters tip-479 map named parameters to local vars} -body { + proc p {{args {color {default: red} flavor {default: strawberry}}}} { + return [list $color $flavor] + } + p +} -result {red strawberry} -cleanup { + rename p "" +} + +test proc-8.1 {Named parameters tip-479 map named parameters to args} -body { + proc p {{args {color {default: red} flavor {default: strawberry}}}} { + return $args + } + p +} -result {} -cleanup { + rename p "" +} + +test proc-8.2 {Named parameters tip-479 present in info locals} -body { + proc p {{args {color {default: red} flavor {default: strawberry}}}} { + return [info locals] + } + p +} -result {args flavor color} -cleanup { + rename p "" +} + +test proc-8.3 {Named parameters tip-479 fail on lack of a named parameter} -body { + proc p {{args {color {} flavor {default: strawberry}}}} { + return $args + } + p +} -returnCodes 1 -result {wrong # args: should be "p ?args?"} -cleanup { + rename p "" +} + +test proc-8.4 {Named parameters tip-479 accept additional named parameters} -body { + proc p {{args {color {default: red} flavor {default: strawberry}}}} { + return $args + } + p shape oval +} -result {shape oval} -cleanup { + rename p "" +} + +test proc-8.5 {Named parameters tip-479 do not map fields outside of the spec} -body { + proc p {{args {color {default: red} flavor {default: strawberry}}}} { + return [info locals] + } + p shape oval +} -result {args flavor color} -cleanup { + rename p "" +} + +test proc-8.6 {Named parameters tip-479 non-manditory fields are not mapped} -body { + proc p {{args {color {default: red} flavor {mandatory: 0}}}} { + return [info locals] + } + p +} -result {args color} -cleanup { + rename p "" +} + +test proc-8.7 {Named parameters tip-479 named parameters can be in any order} -body { + proc p {{args {color {default: red} flavor {default: strawberry}}}} { + return [list $color $flavor] + } + p flavor cherry color blue +} -result {blue cherry} -cleanup { + rename p "" +} + +test proc-8.8 {Named parameters tip-479 order of parameters preserved in args} -body { + proc p {{args {color {default: red} flavor {default: strawberry}}}} { + return $args + } + p flavor cherry color blue +} -result {flavor cherry color blue} -cleanup { + rename p "" +} + +test proc-8.9 {Named parameters tip-479 spec available in [info argspec]} -body { + proc p {{args {color {default: red} flavor {default: strawberry}}}} { + return [info argspec] + } + info argspec p +} -result {color {default: red} flavor {default: strawberry}} -cleanup { + rename p "" +} + +test proc-8.10 {Named parameters tip-479 spec available in [info argspec]} -body { + proc p {{args {color {default: red} flavor {default: strawberry}}}} { + return [info argspec] + } + p +} -result {color {default: red} flavor {default: strawberry}} -cleanup { + rename p "" +} + ::tcltest::cleanupTests return # Local Variables: # mode: tcl