Tcl Source Code

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\" Copyright (c) 2019 Donal K Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH invoke n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
invoke \- Execute a command in a different stack frame
.SH SYNOPSIS
\fBinvoke \fIlevel command \fR?\fIarg ...\fR?
.BE
.SH DESCRIPTION
.PP
The \fBinvoke\fR command concatenates \fIcommand\fR with all of the \fIarg\fR
arguments as if they had been passed to \fBlist\fR; it then evaluates the
result in the variable context indicated by \fIlevel\fR.  \fBInvoke\fR returns
the result of that evaluation.
.PP
If \fIlevel\fR is an integer then it gives a distance (up the procedure
calling stack) to move before executing the command.  If \fIlevel\fR consists
of \fB#\fR followed by a integer then the level gives an absolute level.
.PP
For example, suppose that procedure \fBa\fR was invoked from top-level, and
that it called \fBb\fR, and that \fBb\fR called \fBc\fR.  Suppose that \fBc\fR
invokes the \fBinvoke\fR command.  If \fIlevel\fR is \fB1\fR or \fB#2\fR, then
the command will be executed in the variable context of \fBb\fR.  If
\fIlevel\fR is \fB2\fR or \fB#1\fR then the command will be executed in the
variable context of \fBa\fR.  If \fIlevel\fR is \fB3\fR or \fB#0\fR then the
command will be executed at top-level (only global variables will be visible).
.PP
The \fBinvoke\fR command causes the invoking procedure to disappear from the
procedure calling stack while the command is being executed.  In the above
example, suppose \fBc\fR invokes the command
.PP
.CS
\fBinvoke\fR 1 set x "some arbitrary string"
.CE
.PP
where \fBd\fR is another Tcl procedure.  The \fBset\fR command will modify the
variable \fBx\fR in \fBb\fR's context, at level 3, as if called from \fBb\fR:
the procedure \fBc\fR does not appear to be on the call stack when the
\fBset\fR is executing.  The \fBinfo level\fR command may be used to obtain
the level of the current procedure.
.PP
\fBInvoke\fR makes it possible to implement new control constructs as Tcl
procedures, and is useful in situations where the caller of \fBinvoke\fR is in
control of the arguments (unlike with \fBuplevel\fR which is more suitable for
calling a script provided by the caller of the procedure).
.PP
The \fBnamespace eval\fR and \fBapply\fR commands and TclOO methods offer
other ways (besides procedure calls) that the Tcl naming context can change.
They add a call frame to the stack to represent the namespace context.  This
means each \fBnamespace eval\fR command counts as another call level for
\fBinvoke\fR and \fBupvar\fR commands.  For example, \fBinfo level 1\fR will
return a list describing a command that is either the outermost procedure call
or the outermost \fBnamespace eval\fR command.  Also, \fBinvoke #0\fR
evaluates a command at top-level in the outermost namespace (the global
namespace).
.SH EXAMPLE
As stated above, the \fBinvoke\fR command is useful for creating new control
constructs.  This example shows how (ignoring \fBupvar\fRed variables and
arrays) it can be used to create a \fIlambda\fR command that creates a lambda
term (using \fBapply\fR) that can be in the same namespace context as the
caller of \fBlambda\fR with a copy (effectively read-only) of the local
variables in the stack frame it was called from, for effectively
lexically-scoped variables:
.PP
.CS
proc \fIlambda\fR {args body} {
    set locals [\fBinvoke\fR 1 info locals]
    set arguments [list {*}$locals {*}$args]
    set ns [\fBinvoke\fR 1 namespace current]
    set values [lmap var $locals {\fBinvoke\fR 1 set $var}]
    return [list apply [list $arguments $body $ns] {*}$values]
}

\fI# Demonstrating it in use\fR
namespace eval foo {
    variable b {}

    proc bar {x y} {
        set z [expr {$x + $y}]

        return [\fIlambda\fR a {
            variable b
            lappend b $a
            return $x,$y,$z,$a,[join $b "|"]
        }]
    }
}

set with23 [foo::bar 2 3]
puts [{*}$with23 "demo"]
\fI# ==> 2,3,5,demo,demo\fR
puts [{*}$with23 "again"]
\fI# ==> 2,3,5,again,demo|again\fR

set with45 [foo::bar 4 5]
puts [{*}$with45 "more"]
\fI# ==> 4,5,9,more,demo|again|more\fR
puts [{*}$with23 "again"]
\fI# ==> 2,3,5,again,demo|again|more|again\fR
.CE
.SH "SEE ALSO"
apply(n), namespace(n), uplevel(n), upvar(n)
.SH KEYWORDS
context, level, namespace, stack frame, variable
.\" Local Variables:
.\" mode: nroff
.\" End:

that is, only requested commands that are currently defined
in the exporting namespace are imported.
In other words, you can import only the commands that are in a namespace
at the time when the \fBnamespace import\fR command is executed.
If another command is defined and exported in this namespace later on,
it will not be imported.
.RE
.TP
\fBnamespace invoke\fR \fInamespace cmd\fR ?\fIarg ...\fR?
.VS "TIP 284"
Invokes the command called \fIcmd\fR, as resolved from namespace
\fInamespace\fR, with the supplied arguments; the command is invoked
in the scope of the caller of \fBnamespace invoke\fR, so there are no
intervening stack frames. If \fInamespace\fR does not exist, the
command returns an error.
.VE "TIP 284"
.TP
\fBnamespace inscope\fR \fInamespace\fR \fIscript\fR ?\fIarg ...\fR?
.
Executes a script in the context of the specified \fInamespace\fR.
This command is not expected to be used directly by programmers;
calls to it are generated implicitly when applications
use \fBnamespace code\fR commands to create callback scripts

        if {![\fBuplevel\fR 1 $conditionCmd]} {
            break
        }
    }
}
.CE
.SH "SEE ALSO"
apply(n), namespace(n), upvar(n)
apply(n), invoke(n), namespace(n), upvar(n)
.SH KEYWORDS
context, level, namespace, stack frame, variable
.\" Local Variables:
.\" mode: nroff
.\" End:

    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	CMD_IS_SAFE},
    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	CMD_IS_SAFE},
    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	CMD_IS_SAFE},
    {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	CMD_IS_SAFE},
    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	NULL,	CMD_IS_SAFE},
    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	TclNRIfObjCmd,	CMD_IS_SAFE},
    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	NULL,	CMD_IS_SAFE},
    {"invoke",		Tcl_InvokeObjCmd,	NULL,			TclNRInvokeObjCmd,	CMD_IS_SAFE},
    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
    {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},

MODULE_SCOPE Tcl_ObjCmdProc TclNRApplyObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNREvalObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvokeObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRPackageObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd;

			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_IncrObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_InterpObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int argc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_InvokeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_JoinObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LappendObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

static int		NamespaceExportCmd(ClientData dummy,Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceForgetCmd(ClientData dummy,Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static void		NamespaceFree(Namespace *nsPtr);
static int		NamespaceImportCmd(ClientData dummy,Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceInvokeCmd(ClientData dummy,Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NRNamespaceInvokeCmd(ClientData dummy,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceInscopeCmd(ClientData dummy,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NRNamespaceInscopeCmd(ClientData dummy,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceOriginCmd(ClientData dummy,Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceParentCmd(ClientData dummy,Tcl_Interp *interp,

    {"delete",	   NamespaceDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"ensemble",   TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
    {"eval",	   NamespaceEvalCmd,	NULL, NRNamespaceEvalCmd, NULL, 0},
    {"exists",	   NamespaceExistsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"export",	   NamespaceExportCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"forget",	   NamespaceForgetCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"import",	   NamespaceImportCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"invoke",	   NamespaceInvokeCmd,	TclCompileBasicMin2ArgCmd, NRNamespaceInvokeCmd, NULL, 0},
    {"inscope",	   NamespaceInscopeCmd,	NULL, NRNamespaceInscopeCmd, NULL, 0},
    {"origin",	   NamespaceOriginCmd,	TclCompileNamespaceOriginCmd, NULL, NULL, 0},
    {"parent",	   NamespaceParentCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"path",	   NamespacePathCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0},
    {"tail",	   NamespaceTailCmd,	TclCompileNamespaceTailCmd, NULL, NULL, 0},
    {"unknown",	   NamespaceUnknownCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},

	result = Tcl_Import(interp, NULL, pattern, allowOverwrite);
	if (result != TCL_OK) {
	    return result;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * NamespaceInvokeCmd --
 *
 *	Invoked to implement the "namespace invoke" command that invokes a
 *	command in a predefined namespace. Handles the syntax:
 *
 *	    namespace invoke ns cmd ?arg1? ?arg2? ...
 *
 *      This invokes the command cmd, as resolved from namespace ns, with the
 *      supplied arguments. It is similar to:
 *
 *          namespace eval ns [list cmd ?arg1? ?arg2? ...]
 *
 *      up to the fact that it executes in the caller's context: it does *not*
 *      push a new CallFrame.
 *
 * Results:
 *	Returns TCL_OK if the namespace is found and the command is executed
 *	successfully. Returns TCL_ERROR if anything goes wrong.
 *
 * Side effects:
 *	Returns the result of the command in the interpreter's result object.
 *	If anything goes wrong, this function returns an error message as the
 *	result.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceInvokeCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Namespace *namespacePtr;
    int result;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg...?");
	return TCL_ERROR;
    }

    /*
     * Try to resolve the namespace reference, caching the result in the
     * namespace object along the way. If the namespace is not found, return
     * an error.
     */

    result = TclGetNamespaceFromObj(interp, objv[1], &namespacePtr);
    if (result != TCL_OK) {
	return result;
    }
    if (namespacePtr == NULL) {
	Tcl_AppendResult(interp, "unknown namespace \"",
		Tcl_GetString(objv[1]), "\"", NULL);
	return TCL_ERROR;
    }

    /*
     * Invoke the command in the requested namespace
     */

    iPtr->lookupNsPtr = (Namespace *) namespacePtr;
    return Tcl_EvalObjv(interp, objc - 2, objv + 2, TCL_EVAL_INVOKE);
}

static int
NRNamespaceInvokeCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Namespace *namespacePtr;
    int result;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg...?");
	return TCL_ERROR;
    }

    /*
     * Try to resolve the namespace reference, caching the result in the
     * namespace object along the way. If the namespace is not found, return
     * an error.
     */

    result = TclGetNamespaceFromObj(interp, objv[1], &namespacePtr);
    if (result != TCL_OK) {
	return result;
    }
    if (namespacePtr == NULL) {
	Tcl_AppendResult(interp, "unknown namespace \"",
		Tcl_GetString(objv[1]), "\"", NULL);
	return TCL_ERROR;
    }

    /*
     * Invoke the command in the requested namespace
     */

    iPtr->lookupNsPtr = (Namespace *) namespacePtr;
    return TclNREvalObjv(interp, objc - 2, objv + 2, TCL_EVAL_INVOKE, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * NamespaceInscopeCmd --
 *
 *	Invoked to implement the "namespace inscope" command that executes a

int
TclGetFrame(
    Tcl_Interp *interp,		/* Interpreter in which to find frame. */
    const char *name,		/* String describing frame. */
    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
				 * global frame indicated). */
{
	int result;
	Tcl_Obj obj;
    int result;
    Tcl_Obj obj;

	obj.bytes = (char *) name;
	obj.length = strlen(name);
	obj.typePtr = NULL;
	result = TclObjGetFrame(interp, &obj, framePtrPtr);
	TclFreeIntRep(&obj);
	return result;
    obj.bytes = (char *) name;
    obj.length = strlen(name);
    obj.typePtr = NULL;
    result = TclObjGetFrame(interp, &obj, framePtrPtr);
    TclFreeIntRep(&obj);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjGetFrame --
 *

static int
Uplevel_Callback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallFrame *savedVarFramePtr = data[0];
    const char *msgPiece = data[1];

    if (result == TCL_ERROR) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%s\" body line %d)",
		"\n    (\"uplevel\" body line %d)", Tcl_GetErrorLine(interp)));
		msgPiece, Tcl_GetErrorLine(interp)));
    }

    /*
     * Restore the variable frame, and return.
     */

    ((Interp *)interp)->varFramePtr = savedVarFramePtr;

	 * between, then evaluate the result. Tcl_EvalObjEx will delete the
	 * object when it decrements its refcount after eval'ing it.
	 */

	objPtr = Tcl_ConcatObj(objc, objv);
    }

    TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
	    NULL);
    TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, "uplevel",
	    NULL, NULL);
    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InvokeObjCmd --
 *
 *	This object function is invoked to process the "invoke" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result value.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_InvokeObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRInvokeObjCmd, dummy, objc, objv);
}

int
TclNRInvokeObjCmd(
    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;
    int result;
    CallFrame *savedVarFramePtr, *framePtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "level command ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Find the level to use for executing the command.
     */

    result = TclObjGetFrame(interp, objv[1], &framePtr);
    if (result == -1) {
	return TCL_ERROR;
    } else if (result == 0) {
	/*
	 * Must have a level, and whatever we've got, that's what we haven't
	 * got.
	 */

	const char *name = TclGetString(objv[1]);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
	return TCL_ERROR;
    }

    /*
     * Modify the interpreter state to execute in the given frame.
     */

    savedVarFramePtr = iPtr->varFramePtr;
    iPtr->varFramePtr = framePtr;

    /*
     * Execute the residual arguments as a command.
     */

    TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, "invoke",
	    NULL, NULL);
    return TclNREvalObjv(interp, objc - 2, objv + 2, TCL_EVAL_INVOKE, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFindProc --
 *
 *	Given the name of a procedure, return a pointer to the record

    proc p1 {} {
	    return 16fe1b5807
    }
}

: p1
} 16fe1b5807

namespace eval ::namespace-57 {
test namespace-57.1 {namespace invoke} -returnCodes error -body {
    namespace invoke
} -result {wrong # args: should be "namespace invoke name cmd ?arg...?"}
test namespace-57.2 {namespace invoke} -returnCodes error -body {
    namespace invoke no_such_namespace namespace current
} -result {namespace "no_such_namespace" not found in "::namespace-57"}
test namespace-57.3 {namespace invoke} -returnCodes error -body {
    namespace invoke :: definitely_no_such_command
} -result {invalid command name "definitely_no_such_command"}
test namespace-57.4 {namespace invoke doesn't push a namespace} -body {
    namespace invoke :: namespace current
} -result ::namespace-57
test namespace-57.5 {namespace invoke resolves in the given ns} -setup {
    namespace eval ns {}
} -body {
    proc target {} {return "in origin"}
    proc ns::target {} {return "in target"}
    namespace invoke ns target
} -cleanup {
    rename target {}
    namespace delete ns
} -result {in target}
test namespace-57.6 {namespace invoke resolves in the given ns} -setup {
    namespace eval ns {}
} -body {
    namespace eval ns::tcl {}
    namespace invoke ns tcl::prefix match {a bcd e} b
} -cleanup {
    namespace delete ns
} -result bcd
test namespace-57.7 {namespace invoke resolves in the given ns} -setup {
    namespace eval ns {}
} -body {
    namespace eval ns::tcl {proc prefix args {return ok}}
    namespace invoke ns tcl::prefix match {a bcd e} b
} -cleanup {
    namespace delete ns
} -result ok
test namespace-57.8 {namespace invoke resolves in the given ns} -setup {
    namespace eval ns {}
    namespace eval ns2 {
	proc foo {} {return "this is in ns2"}
    }
} -body {
    namespace eval ns {
	namespace path ::namespace-57::ns2
    }
    namespace invoke ns foo
} -cleanup {
    namespace delete ns
} -result {this is in ns2}
test namespace-57.9 {namespace invoke preserves word boundaries} -setup {
    namespace eval ns {
	proc count args {list [llength $args] $args}
    }
} -body {
    namespace invoke ns count a {b c} gorp
} -cleanup {
    namespace delete ns
} -result {3 {a {b c} gorp}}
test namespace-57.10 {namespace invoke is NRE-aware} -setup {
    namespace eval ns {}
} -body {
    proc ns::count args {
	yield $args
	return [llength $args]
    }
    coroutine c apply {args {
	yield
	namespace invoke ns count {*}$args
    } ::namespace-57} a {b c} gorp
    list [c] [c]
} -cleanup {
    namespace delete ns
} -result {{a {b c} gorp} 3}
}

# cleanup
catch {rename cmd1 {}}
catch {unset l}
catch {unset msg}
catch {unset trigger}
namespace delete {*}[namespace children :: test_ns_*]

# Commands covered:  uplevel
# Commands covered:  uplevel, invoke
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.

    }
    foo
    moo
} -cleanup {
    rename foo {}
    rename moo {}
} -result {3 3 3}

test invoke-1.1 {invoke command usage} -returnCodes error -body {
    invoke
} -result {wrong # args: should be "invoke level command ?arg ...?"}
test invoke-1.2 {invoke command usage} -returnCodes error -body {
    invoke 0
} -result {wrong # args: should be "invoke level command ?arg ...?"}
test invoke-1.3 {invoke command usage} -returnCodes error -body {
    invoke list a b c
} -result {bad level "list"}
test invoke-1.4 {invoke command usage} -returnCodes error -body {
    invoke 50000 list a b c
} -result {bad level "50000"}
test invoke-1.5 {invoke preserves word boundaries} -body {
    invoke 0 list "a b" c
} -result {{a b} c}
test invoke-1.6 {invoke walks the stack} -body {
    apply {x {
	apply {x {
	    apply {x {
		apply {{x levels} {
		    lmap l $levels {string cat $l -> [invoke $l set x]}
		}} jkl {3 2 1 0 #1 #2 #3 #4}
	    }} ghi
	}} def
    }} abc
} -result {3->abc 2->def 1->ghi 0->jkl #1->abc #2->def #3->ghi #4->jkl}
test invoke-1.7 {invoke is NRE-aware} -body {
    coroutine c apply {{} {
	set x [yield]
	list [apply {x {
	    invoke 1 eval {set x [yield $x]}
	    return $x
	}} $x,$x] $x
    }}
    list [c 135] [c 246]
} -result {135 {135,135 246}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End: