Tcl Source Code

.SS "NAMED ARGUMENTS HANDLING"
.VS
.PP
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.
.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.
.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
This is a procedure that takes two arguments and prints both their sum
and their product. It also returns the string
.QW OK
to the caller as an explicit result.

    {level -name level -switch {{debug 0} {error 3}} -default 1}
    {time -name {time timestamp}}
    {message} } {
  if {![info exists time]} {set time [clock seconds]}
  array set levels {0 DEBUG 1 INFO 2 WARN 3 ERROR}
  puts "[clock format $time] : $levels($level) : $message"
}





.CE
.SH "SEE ALSO"
info(n), unknown(n)
.SH KEYWORDS
argument, procedure
'\" Local Variables:
'\" mode: nroff
'\" End:

 * The structure below describes an extended argument specification applied
 * on a proc argument (see TIP#457).
 */

typedef struct ExtendedArgSpec {
    struct NamedGroupEntry *firstNamedEntryPtr;
				/* Pointer to the first named parameter entry
				 * 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;

/*
 * The variable-length structure below describes a local variable of a
 * procedure that was recognized by the compiler. These variables have a name,

/*
 * Flag bits for procedures.
 *
 * 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
 * of a procedure (or lambda term or ...).
 */

typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);

static void		ProcBodyFree(Tcl_Obj *objPtr);
static int		ProcWrongNumArgs(Tcl_Interp *interp, int skip);
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		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,
			    Tcl_HashTable **namedHashPtrPtr);
static inline int	ProcCheckScalarArg(const char *arg, const char **err);
static void		ProcCompiledLocalsFree(CompiledLocal *localPtr);

	    } else {
		procPtr->lastLocalPtr->nextPtr = newLocalPtr;
	    }
	    procPtr->lastLocalPtr = newLocalPtr;

	    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;
    ckfree(argArray);
    return TCL_OK;

  procError:

 * Results:
 *	Returns TCL_OK on success and TCL_ERROR if anything goes wrong.
 *
 * Side effects:
 *	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. The variable pointed
 *	by lastEntryPtr will be updated to always contain the pointer
 *	of the last entry.
 *
 *----------------------------------------------------------------------
 */

static int
ProcAddNamedGroupEntry(
    Tcl_Interp *interp,		/* Interpreter containing proc. */
    CompiledLocal *localPtr,	/* Related CompiledLocal */
    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
				 * of named parameters. */
{
    NamedGroupEntry *entryPtr;
    ExtendedArgSpec *argSpecPtr = localPtr->argSpecPtr;

    if (entryPtr->valuePtr != NULL) {
	Tcl_IncrRefCount(entryPtr->valuePtr);
    }

    if (argSpecPtr->firstNamedEntryPtr == NULL) {
	argSpecPtr->firstNamedEntryPtr = entryPtr;
    } else {
	(*lastEntryPtr)->nextPtr = entryPtr;
    }
    *lastEntryPtr = entryPtr;

    /* Either use existing hash table or create a new one */

    if (*namedHashPtrPtr != NULL) {
	namedHashPtr = *namedHashPtrPtr;
    }
    else {

    Tcl_HashTable **namedHashPtrPtr)
				/* Shared Tcl_HashTable created on the first
				 * named parameter entry to speedup lookups
				 * of named parameters. */
{
    CompiledLocal *localPtr = NULL;
    ExtendedArgSpec *argSpecPtr;
    NamedGroupEntry *lastNamedEntryPtr = NULL;
    const char **fieldValues = NULL;
    int fieldCount, length;
    const char *err;
    int required = -1, hasSwitch = 0;
    int result, i, j;

    /*

    /*
     * Check and handle each extended argument specification.
     */

    argSpecPtr = ckalloc(sizeof(ExtendedArgSpec));
    argSpecPtr->firstNamedEntryPtr = NULL;

    argSpecPtr->namedHashTable = NULL;
    argSpecPtr->remainAfterNamedGroup = -1;
    argSpecPtr->upvarLevelPtr = NULL;
    localPtr->argSpecPtr = argSpecPtr;

    for (i = 1 ; i < fieldCount ; i += 2) {
	length = strlen(fieldValues[i]);

	if (*fieldValues[i] != '-') {

		    &nameValues);
	    if (result != TCL_OK) {
		goto parseError;
	    }

	    for (j = 0; j < nameCount; j++) {
		result = ProcAddNamedGroupEntry(interp, localPtr,
		    nameValues[j], NULL, &lastNamedEntryPtr, namedHashPtrPtr);
		if (result != TCL_OK) {
		    ckfree(nameValues);
		    goto parseError;
		}
	    }

	    ckfree(nameValues);

		    goto parseError;
		}

		if (swEntCount == 1) {
		    /* one field, use switch name as value */
		    result = ProcAddNamedGroupEntry(interp, localPtr,
			swEntValues[0], Tcl_NewStringObj(swEntValues[0], -1),
			&lastNamedEntryPtr, namedHashPtrPtr);
		} else if (swEntCount == 2) {
		    /* two fields, use second one as value */
		    result = ProcAddNamedGroupEntry(interp, localPtr,
			swEntValues[0], Tcl_NewStringObj(swEntValues[1], -1),
			&lastNamedEntryPtr, namedHashPtrPtr);
		} else {
		    /* invalid number of fields */
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"incorrect switch value \"%s\"", swValues[j]));
		    result = TCL_ERROR;
		}
		ckfree(swEntValues);

	    /*
	     * Start of a named argument group. Handle all of them together.
	     */

	    for (; iArg < argCt; iArg++) {

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

		optStr = TclGetString(argObjs[iArg]);

		if (*optStr != '-') {
		    /* argument without leading dash, end named group */

} {{0 B 5 D E} {0 0 foo 0 E}}
test proc-enh-2.14 {correct usage: named arg without required is optionnal} {
    proc p {{a -name A}} {
	if {[info exists a]} { return $a } else { return unset }
    };
    list [p] [p -A 2]
} {unset 2}
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]
    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} {
    proc p {{a -name A} {b -name B -default 1}} { }
    list [catch { p -A } msg] $msg $errorCode
} {1 {wrong # args: should be "p ?|-A a|? ?|-B b|?"} {TCL WRONGARGS}}
test proc-enh-3.2 {wrong # args: named group ended by an arg with leading dash} {