TIP#457: Update named group endingtip_457

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} {