From 54868765b61d327129b4bf27a19342f1448a2ffd Mon Sep 17 00:00:00 2001 From: mlafon Date: Tue, 23 May 2017 22:36:27 +0000 Subject: TIP#457: Update named group ending --- doc/proc.n | 29 +++++++++++++-------- generic/tclInt.h | 13 +++++++--- generic/tclProc.c | 72 +++++++++++++++++++++++++++++++++++++++++++++-------- tests/proc-enh.test | 10 ++++---- 4 files changed, 93 insertions(+), 31 deletions(-) diff --git a/doc/proc.n b/doc/proc.n index 2dc2e3b..83487df 100644 --- a/doc/proc.n +++ b/doc/proc.n @@ -151,15 +151,27 @@ Named argument are arguments defined using the \fB-name\fR or \fB-switch\fR extended argument specifiers. They have a special handling on call-site. All contiguous named arguments, called named group, are handled together, they are not required to be declared in order, can be omited or declared -multiple times. The handling of a named group is started when previous -formal arguments have been assigned. +multiple times. +.PP +The handling of a named group is started when previous formal arguments have +been assigned. Each named parameter uses a string starting with a dash character, followed by the name of the related argument. If it is not a switch argument, it is -followed by the value to assign to the formal argument. The handling of -a named group is ended if the next parameter is a multiple-elements list, -does not start with a dash or is the special \fB--\fR keyword. Remaining -parameters, except the \fB--\fR keyword if used, are then assigned to +followed by the value to assign to the formal argument. +.PP +The handling of +a named group is ended if the next parameter does not start with a dash or is +the special \fB--\fR keyword. In the case where the arguments after the named +group are all non-optional positional arguments and do not end with \fBargs\fR, +the handling of the named group will also be ended when the number of remaining +parameters will be equal to the number of the remaining positional arguments. +When the handling of named argument has been ended, remaining parameters, +except the \fB--\fR keyword if used, are then assigned to following positional arguments using the default handling. +.PP +It is recommended to explicitely use the \fB--\fR keyword if the next parameter +following the named group is a variable which may start with a dash, or if it +is an object which can be expensive to stringify. .VE .SH EXAMPLES .PP @@ -221,11 +233,6 @@ be left unset in the procedure. array set levels {0 DEBUG 1 INFO 2 WARN 3 ERROR} puts "[clock format $time] : $levels($level) : $message" } - -% log -level 2 "Warning..." -Sun Apr 23 20:29:41 UTC 2017 : WARN : Warning... -% log -timestamp 946684800 -debug -- -Y2K- -Sat Jan 01 00:00:00 UTC 2000 : DEBUG : -Y2K- .CE .SH "SEE ALSO" info(n), unknown(n) diff --git a/generic/tclInt.h b/generic/tclInt.h index 5b8ee23..5e4c4b8 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -947,15 +947,17 @@ typedef struct NamedGroupEntry { typedef struct ExtendedArgSpec { struct NamedGroupEntry *firstNamedEntryPtr; /* Pointer to the first named parameter entry - * defined on the proc argument. */ - struct NamedGroupEntry *lastNamedEntryPtr; - /* Pointer to the last named parameter entry - * defined on the proc argument. */ + * defined on this proc argument. */ Tcl_HashTable *namedHashTable; /* Pointer to the hash table created for a * fast lookup of named entry. The pointer is * only set on the first local of a named * group. */ + int remainAfterNamedGroup; /* If the number of arguments after a named + * group is fixed and non-optional, this will + * contain that number. Otherwise, will be set + * to -1. This is only set on the first local + * of a named group. */ Tcl_Obj *upvarLevelPtr; /* Pointer to the level value specified using * the -upvar specifier. */ } ExtendedArgSpec; @@ -1050,9 +1052,12 @@ typedef struct Proc { * PROC_HAS_EXT_ARG_SPEC 1 means that the procedure has at least one * argument defined using an extended argument * specification. + * PROC_HAS_NAMED_GROUP 1 means that the procedure has at least one + * named group. */ #define PROC_HAS_EXT_ARG_SPEC 0x01 +#define PROC_HAS_NAMED_GROUP 0x02 /* * The type of functions called to process errors found during the execution diff --git a/generic/tclProc.c b/generic/tclProc.c index 9469bfc..beeb074 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -50,6 +50,10 @@ static void MakeProcError(Tcl_Interp *interp, static void MakeLambdaError(Tcl_Interp *interp, Tcl_Obj *procNameObj); static int SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static int ProcAddNamedGroupEntry(Tcl_Interp *interp, + CompiledLocal *localPtr, const char *argName, + Tcl_Obj *valuePtr, NamedGroupEntry **lastEntryPtr, + Tcl_HashTable **namedHashPtrPtr); static int ProcParseArgSpec(Tcl_Interp *interp, const char *argSpec, int argIdx, int isLastArg, CompiledLocal **localPtrPtr, @@ -585,8 +589,45 @@ TclCreateProc( if (TclIsVarWithExtArgs(newLocalPtr)) { procPtr->flags |= PROC_HAS_EXT_ARG_SPEC; + if (newLocalPtr->flags & VAR_NAMED_GROUP) { + procPtr->flags |= PROC_HAS_NAMED_GROUP; + } + } + } + } + + if ((procPtr->flags & PROC_HAS_NAMED_GROUP) + && !(procPtr->lastLocalPtr->flags & (VAR_IS_ARGS|VAR_ARG_OPTIONAL)) + && (procPtr->lastLocalPtr->defValuePtr == NULL)) { + + /* proc with at least one named group and a non-optional and non-args + * last variable. Find and store the number of arguments after the + * last named group, this will be used to end the named group handling + * and ensure the last input arguments can be assigned. + */ + + CompiledLocal *lastNamedGroupPtr = NULL; + for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; + localPtr = localPtr->nextPtr) { + if ((localPtr->argSpecPtr != NULL) + && (localPtr->argSpecPtr->namedHashTable != NULL)) { + lastNamedGroupPtr = localPtr; } } + + /* find last entry of the named group */ + for (localPtr = lastNamedGroupPtr; localPtr != NULL; + localPtr = localPtr->nextPtr) { + if ((localPtr->nextPtr == NULL) + || !(localPtr->nextPtr->flags & VAR_NAMED_GROUP)) { + break; + } + } + + if (localPtr != NULL) { + lastNamedGroupPtr->argSpecPtr->remainAfterNamedGroup = + procPtr->lastLocalPtr->frameIndex - localPtr->frameIndex; + } } *procPtrPtr = procPtr; @@ -675,7 +716,9 @@ ProcCheckScalarArg( * If anything goes wrong, this function returns an error message in the * interpreter. On success, memory is allocated and linked into the * ExtendedArgSpec structure. A Tcl_HashTable is allocated when - * parsing the first entry of a named group entry. + * parsing the first entry of a named group entry. The variable pointed + * by lastEntryPtr will be updated to always contain the pointer + * of the last entry. * *---------------------------------------------------------------------- */ @@ -687,6 +730,9 @@ ProcAddNamedGroupEntry( const char *argName, /* Name string to add */ Tcl_Obj *valuePtr, /* Value to add when related to a -switch * argspec (NULL for -name argspec) */ + NamedGroupEntry **lastEntryPtr, + /* Pointer to a variable which contain the current + * last named entry for this local. */ Tcl_HashTable **namedHashPtrPtr) /* Shared Tcl_HashTable created on the first * named parameter entry to speedup lookups @@ -734,9 +780,9 @@ ProcAddNamedGroupEntry( if (argSpecPtr->firstNamedEntryPtr == NULL) { argSpecPtr->firstNamedEntryPtr = entryPtr; } else { - argSpecPtr->lastNamedEntryPtr->nextPtr = entryPtr; + (*lastEntryPtr)->nextPtr = entryPtr; } - argSpecPtr->lastNamedEntryPtr = entryPtr; + *lastEntryPtr = entryPtr; /* Either use existing hash table or create a new one */ @@ -799,6 +845,7 @@ ProcParseArgSpec( { CompiledLocal *localPtr = NULL; ExtendedArgSpec *argSpecPtr; + NamedGroupEntry *lastNamedEntryPtr = NULL; const char **fieldValues = NULL; int fieldCount, length; const char *err; @@ -873,8 +920,8 @@ ProcParseArgSpec( argSpecPtr = ckalloc(sizeof(ExtendedArgSpec)); argSpecPtr->firstNamedEntryPtr = NULL; - argSpecPtr->lastNamedEntryPtr = NULL; argSpecPtr->namedHashTable = NULL; + argSpecPtr->remainAfterNamedGroup = -1; argSpecPtr->upvarLevelPtr = NULL; localPtr->argSpecPtr = argSpecPtr; @@ -921,7 +968,7 @@ ProcParseArgSpec( for (j = 0; j < nameCount; j++) { result = ProcAddNamedGroupEntry(interp, localPtr, - nameValues[j], NULL, namedHashPtrPtr); + nameValues[j], NULL, &lastNamedEntryPtr, namedHashPtrPtr); if (result != TCL_OK) { ckfree(nameValues); goto parseError; @@ -959,12 +1006,12 @@ ProcParseArgSpec( /* one field, use switch name as value */ result = ProcAddNamedGroupEntry(interp, localPtr, swEntValues[0], Tcl_NewStringObj(swEntValues[0], -1), - namedHashPtrPtr); + &lastNamedEntryPtr, namedHashPtrPtr); } else if (swEntCount == 2) { /* two fields, use second one as value */ result = ProcAddNamedGroupEntry(interp, localPtr, swEntValues[0], Tcl_NewStringObj(swEntValues[1], -1), - namedHashPtrPtr); + &lastNamedEntryPtr, namedHashPtrPtr); } else { /* invalid number of fields */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -2064,10 +2111,13 @@ InitArgsWithOptions( for (; iArg < argCt; iArg++) { - if ((argObjs[iArg]->typePtr == &tclListType) - && (ListRepPtr(argObjs[iArg])->elemCount > 1)) { - /* multiple-elements list, end named group before getting - * string representation. */ + if ((localPtr->argSpecPtr != NULL) + && (localPtr->argSpecPtr->remainAfterNamedGroup > 0) + && ((argCt - iArg) <= + localPtr->argSpecPtr->remainAfterNamedGroup)) { + /* Remaining arguments must be assigned to remaining + * positional locals after named group, end handling + */ break; } diff --git a/tests/proc-enh.test b/tests/proc-enh.test index b6cc7a4..20e59af 100644 --- a/tests/proc-enh.test +++ b/tests/proc-enh.test @@ -180,13 +180,13 @@ test proc-enh-2.14 {correct usage: named arg without required is optionnal} { }; list [p] [p -A 2] } {unset 2} -test proc-enh-2.15 {correct usage: multi-elems list must not be handled as a named name} { - proc p {{a -name A -default 0} b} { - list $a $b +test proc-enh-2.15 {correct usage: fixed number of arguments after named group, automatically ended} { + proc p {{a -name A -default 0} {b -name B -default 0} c} { + list $a $b $c }; set l [list -Z 1] - p $l -} {0 {-Z 1}} + list [p -2] [p -A 1 -5] [p -- -3] [p --] +} {{0 0 -2} {1 0 -5} {0 0 -3} {0 0 --}} # proc-enh-3.x: wrong # args test proc-enh-3.1 {wrong # args: -name arg without value} { -- cgit v0.12