Tcl Source Code

'\"
'\" Copyright (c) 2023 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 const n 9.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
const \- create and initialize a constant
.SH SYNOPSIS
\fBconst \fIvarName value\fR
.BE
.SH DESCRIPTION
.PP
This command is normally used within a procedure body (or method body, 
or lambda term) to create a constant within that procedure, or within a 
\fBnamespace eval\fR body to create a constant within that namespace. 
The constant is an unmodifiable variable, called \fIvarName\fR, that is 
initialized with \fIvalue\fR.
The result of \fBconst\fR is always the empty string on success.
.PP
If a variable \fIvarName\fR does not exist, it is created with its value set 
to \fIvalue\fR and marked as a constant; this means that no other command
(e.g., \fBset\fR, \fBappend\fR, \fBincr\fR, \fBunset\fR)
may modify or remove the variable; variables are checked for whether they 
are constants before any traces are called.
If a variable \fIvarName\fR already exists, it is an error unless that 
variable is marked as a constant (in which case \fBconst\fR is a no-op).
.PP
The \fIvarName\fR may not be a qualified name or reference an element of an 
array by any means. If the variable exists and is an array, that is an error.
.PP
Constants are normally only removed by their containing procedure exiting or 
their namespace being deleted.
.SH EXAMPLES
.PP
Create a constant in a procedure:
.PP
.CS
proc foo {a b} {
    \fBconst\fR BAR 12345
    return [expr {$a + $b + $BAR}]
}
.CE
.PP
Create a constant in a namespace to factor out a regular expression:
.PP
.CS
namespace eval someNS {
    \fBconst\fR FOO_MATCHER {(?i)}\emfoo\eM}

    proc findFoos str {
        variable FOO_MATCHER
        regexp -all $FOO_MATCHER $str
    }

    proc findFooIndices str {
        variable FOO_MATCHER
        regexp -all -indices $FOO_MATCHER $str
    }
}
.CE
.PP
Making a constant in a loop doesn't error:
.PP
.CS
proc foo {n} {
    set result {}
    for {set i 0} {$i < $n} {incr i} {
        \fBconst\fR X 123
	lappend result [expr {$X + $i**2}]
    }
}
.CE
.SH "SEE ALSO"
proc(n), namespace(n), set(n), unset(n)
.SH KEYWORDS
namespace, procedure, variable, constant
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

\fBnamespace\fR(n) documentation.
.TP
\fBinfo complete \fIcommand\fR
.
Returns 1 if \fIcommand\fR is a complete command, and \fB0\fR otherwise.
Typically used in line-oriented input environments
to allow users to type in commands that span multiple lines.
.TP
\fBinfo constant \fIvarName\fR
.VS "TIP 677"
Returns 1 if \fIvarName\fR is a constant variable (see \fBconst\fR) and 0
otherwise.
.VE "TIP 677"
.TP
\fBinfo consts\fR ?\fIpattern\fR?
.VS "TIP 677"
Returns the list of constant variables (see \fBconst\fR) in the current scope,
or the list of constant variables matching \fIpattern\fR (if that is provided)
in a manner similar to \fBinfo vars\fR.
.VE "TIP 677"
.TP
\fBinfo coroutine\fR
.
Returns the name of the current \fBcoroutine\fR, or the empty
string if there is no current coroutine or the current coroutine
has been deleted.
.TP

     */

    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
    {"const", 		Tcl_ConstObjCmd,	TclCompileConstCmd,	NULL,	CMD_IS_SAFE},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
    {"coroinject",	NULL,			NULL,                   TclNRCoroInjectObjCmd,	CMD_IS_SAFE},
    {"coroprobe",	NULL,			NULL,                   TclNRCoroProbeObjCmd,	CMD_IS_SAFE},
    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},
    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	CMD_IS_SAFE},
    {"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},
    {"fpclassify",      FloatClassifyObjCmd,    NULL,                   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},
    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
    {"ledit",		Tcl_LeditObjCmd,	NULL,			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},
    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
    {"lpop",		Tcl_LpopObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},

static const EnsembleImplMap defaultInfoMap[] = {
    {"args",		   InfoArgsCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"body",		   InfoBodyCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"cmdcount",	   InfoCmdCountCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"cmdtype",		   InfoCmdTypeCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
    {"complete",	   InfoCompleteCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"constant",	   TclInfoConstantCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"consts",		   TclInfoConstsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"coroutine",	   TclInfoCoroutineCmd,     TclCompileInfoCoroutineCmd, NULL, NULL, 0},
    {"default",		   InfoDefaultCmd,	    TclCompileBasic3ArgCmd, NULL, NULL, 0},
    {"errorstack",	   InfoErrorStackCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"exists",		   TclInfoExistsCmd,	    TclCompileInfoExistsCmd, NULL, NULL, 0},
    {"frame",		   InfoFrameCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"functions",	   InfoFunctionsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"globals",		   TclInfoGlobalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},

	CompileWord(envPtr, tokenPtr, interp, i);
    }

    TclEmitInstInt4(	INST_CONCAT_STK, i-1,		envPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileConstCmd --
 *
 *	Procedure called to compile the "const" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "const" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileConstCmd(
    Tcl_Interp *interp,		/* The interpreter. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int isScalar, localIndex;

    /*
     * Need exactly two arguments. 
     */
    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace
     * qualifiers.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
	    &localIndex, &isScalar, 1);

    /*
     * If the user specified an array element, we don't bother handling
     * that. 
     */
    if (!isScalar) {
        return TCL_ERROR;
    }

    /*
     * We are doing an assignment to set the value of the constant. This will
     * need to be extended to push a value for each argument.
     */

    valueTokenPtr = TokenAfter(varTokenPtr);
    CompileWord(envPtr, valueTokenPtr, interp, 2);

    if (localIndex < 0) {
	TclEmitOpcode(INST_CONST_STK, envPtr);
    } else {
	TclEmitInstInt4(INST_CONST_IMM, localIndex, envPtr);
    }

    /*
     * The const command's result is an empty string.
     */
    PushStringLiteral(envPtr, "");
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileContinueCmd --
 *
 *	Procedure called to compile the "continue" command.

    {"lreplace4",	  6,   INT_MIN,    2,	{OPERAND_UINT4, OPERAND_UINT1}},
	/* Operands: number of arguments, flags
	 * flags: Combination of TCL_LREPLACE4_* flags
	 * Stack: ... listobj index1 ?index2? new1 ... newN => ... newlistobj
	 * where index2 is present only if TCL_LREPLACE_SINGLE_INDEX is not
	 * set in flags.
	 */

    {"constImm",	  5,   -1,	   1,	{OPERAND_LVT4}},
	/* Create constant. Index into LVT is immediate, value is on stack.
	 * Stack: ... value => ... */
    {"constStk",	  1,   -2,	   0,	{OPERAND_NONE}},
	/* Create constant. Variable name and value on stack.
	 * Stack: ... varName value => ... */

    {NULL, 0, 0, 0, {OPERAND_NONE}}
};

/*
 * Prototypes for procedures defined later in this file:
 */

	/* TIP 461 */
	INST_STR_LT,
	INST_STR_GT,
	INST_STR_LE,
	INST_STR_GE,

    INST_LREPLACE4,

    /* TIP 667: const */
    INST_CONST_IMM,
    INST_CONST_STK,

    /* The last opcode */
    LAST_INST_OPCODE
};

/*
 * Table describing the Tcl bytecode instructions: their name (for displaying

	TRACE_ERROR(interp);
	goto gotError;
    }
    break;

    /*
     *	   End of INST_UNSET instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_CONST instructions.
     */
    {
	const char *msgPart;

    case INST_CONST_IMM:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;
	cleanup = 1;
	part1Ptr = NULL;
	objPtr = OBJ_AT_TOS;
	TRACE(("%u "\"%.30s\" => \n", opnd, O2S(objPtr)));
	varPtr = LOCAL(opnd);
	arrayPtr = NULL;
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	goto doConst;
    case INST_CONST_STK:
	opnd = -1;
	pcAdjustment = 1;
	cleanup = 2;
	part1Ptr = OBJ_UNDER_TOS;
	objPtr = OBJ_AT_TOS;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(part1Ptr), O2S(objPtr)));
	varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL,
		/*createPart1*/1, /*createPart2*/0, &arrayPtr);
    doConst:
    	if (TclIsVarConstant(varPtr)) {
	    TRACE_APPEND(("\n"));
	    NEXT_INST_V(pcAdjustment, cleanup, 0);
	}
	if (TclIsVarArray(varPtr)) {
	    msgPart = "variable is array";
	    goto constError;
	} else if (TclIsVarArrayElement(varPtr)) {
	    msgPart = "name refers to an element in an array";
	    goto constError;
	} else if (!TclIsVarUndefined(varPtr)) {
	    msgPart = "variable already exists";
	    goto constError;
	}
	if (TclIsVarDirectModifyable(varPtr)) {
	    varPtr->value.objPtr = objPtr;
	    Tcl_IncrRefCount(objPtr);
	} else {
	    Tcl_Obj *resPtr;

	    DECACHE_STACK_INFO();
	    resPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, NULL, 
		    objPtr, TCL_LEAVE_ERR_MSG, opnd);
	    CACHE_STACK_INFO();
	    if (resPtr == NULL) {
		TRACE_ERROR(interp);
		goto gotError;
	    }
	}
	TclSetVarConstant(varPtr);
	TRACE_APPEND(("\n"));
	NEXT_INST_V(pcAdjustment, cleanup, 0);

    constError:
	TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", msgPart, opnd);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (void *)NULL);
	TRACE_ERROR(interp);
	goto gotError;
    }

    /*
     *	   End of INST_CONST instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_ARRAY instructions.
     */

    case INST_ARRAY_EXISTS_IMM:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;

 * VAR_LINK -			1 means this Var structure contains a pointer
 *				to another Var structure that either has the
 *				real value or is itself another VAR_LINK
 *				pointer. Variables like this come about
 *				through "upvar" and "global" commands, or
 *				through references to variables in enclosing
 *				namespaces.
 * VAR_CONSTANT -		1 means this is a constant "variable", and 
 *				cannot be written to by ordinary commands. 
 *				Structurally, it's the same as a scalar when
 *				being read, but writes are rejected. Constants
 *				are not supported inside arrays.
 *
 * Flags that indicate the type and status of storage; none is set for
 * compiled local variables (Var structs).
 *
 * VAR_IN_HASHTABLE -		1 means this variable is in a hash table and
 *				the Var structure is malloc'ed. 0 if it is a
 *				local variable that was assigned a slot in a

 * Keep the flag values for VAR_ARGUMENT and VAR_TEMPORARY so that old values
 * in precompiled scripts keep working.
 */

/* Type of value (0 is scalar) */
#define VAR_ARRAY		0x1
#define VAR_LINK		0x2
#define VAR_CONSTANT		0x10000

/* Type of storage (0 is compiled local) */
#define VAR_IN_HASHTABLE	0x4
#define VAR_DEAD_HASH		0x8
#define VAR_ARRAY_ELEMENT	0x1000
#define VAR_NAMESPACE_VAR	0x80	/* KEEP OLD VALUE for Itcl */

/*
 * Macros to ensure that various flag bits are set properly for variables.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE void	TclSetVarScalar(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarArray(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarLink(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarConstant(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarArrayElement(Var *varPtr);
 * MODULE_SCOPE void	TclSetVarUndefined(Var *varPtr);
 * MODULE_SCOPE void	TclClearVarUndefined(Var *varPtr);
 */

#define TclSetVarScalar(varPtr) \
    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK|VAR_CONSTANT)

#define TclSetVarArray(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~VAR_LINK) | VAR_ARRAY

#define TclSetVarLink(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_LINK

#define TclSetVarConstant(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_CONSTANT

#define TclSetVarArrayElement(varPtr) \
    (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT

#define TclSetVarUndefined(varPtr) \
    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK|VAR_CONSTANT);\
    (varPtr)->value.objPtr = NULL

#define TclClearVarUndefined(varPtr)

#define TclSetVarTraceActive(varPtr) \
    (varPtr)->flags |= VAR_TRACE_ACTIVE

    }

/*
 * Macros to read various flag bits of variables.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE int	TclIsVarScalar(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarConstant(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarLink(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArray(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarUndefined(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArrayElement(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarTemporary(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarArgument(Var *varPtr);
 * MODULE_SCOPE int	TclIsVarResolved(Var *varPtr);

#define TclIsVarLink(varPtr) \
    ((varPtr)->flags & VAR_LINK)

#define TclIsVarArray(varPtr) \
    ((varPtr)->flags & VAR_ARRAY)

/* Implies scalar as well. */
#define TclIsVarConstant(varPtr) \
    ((varPtr)->flags & VAR_CONSTANT)

#define TclIsVarUndefined(varPtr) \
    ((varPtr)->value.objPtr == NULL)

#define TclIsVarArrayElement(varPtr) \
    ((varPtr)->flags & VAR_ARRAY_ELEMENT)

#define TclIsVarNamespaceVar(varPtr) \

                && (TclVarParentArray(varPtr)->flags & (trickyFlags))))

#define TclIsVarDirectReadable(varPtr)					\
    (   (!TclIsVarTricky(varPtr,VAR_TRACED_READ))			\
          && (varPtr)->value.objPtr)

#define TclIsVarDirectWritable(varPtr) \
    (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT))

#define TclIsVarDirectUnsettable(varPtr) \
    (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH|VAR_CONSTANT))

#define TclIsVarDirectModifyable(varPtr) \
    (   (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT))	\
          &&  (varPtr)->value.objPtr)

#define TclIsVarDirectReadable2(varPtr, arrayPtr) \
    (TclIsVarDirectReadable(varPtr) &&\
	(!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ)))

#define TclIsVarDirectWritable2(varPtr, arrayPtr) \

			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
MODULE_SCOPE Tcl_ObjCmdProc TclInfoExistsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInfoCoroutineCmd;
MODULE_SCOPE Tcl_Obj *	TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
MODULE_SCOPE Tcl_ObjCmdProc TclInfoGlobalsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInfoLocalsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInfoVarsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInfoConstsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInfoConstantCmd;
MODULE_SCOPE void	TclInitAlloc(void);
MODULE_SCOPE void	TclInitDbCkalloc(void);
MODULE_SCOPE void	TclInitDoubleConversion(void);
MODULE_SCOPE void	TclInitEmbeddedConfigurationInformation(
			    Tcl_Interp *interp);
MODULE_SCOPE void	TclInitEncodingSubsystem(void);
MODULE_SCOPE void	TclInitIOSubsystem(void);

MODULE_SCOPE Tcl_ObjCmdProc TclChanPostEventObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPopObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPushObjCmd;
MODULE_SCOPE void	TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc TclClockOldscanObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_CloseObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConcatObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ContinueObjCmd;
MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
			    void *clientData);
MODULE_SCOPE Tcl_ObjCmdProc TclDefaultBgErrorHandlerObjCmd;
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,

MODULE_SCOPE CompileProc TclCompileArraySetCmd;
MODULE_SCOPE CompileProc TclCompileArrayUnsetCmd;
MODULE_SCOPE CompileProc TclCompileBreakCmd;
MODULE_SCOPE CompileProc TclCompileCatchCmd;
MODULE_SCOPE CompileProc TclCompileClockClicksCmd;
MODULE_SCOPE CompileProc TclCompileClockReadingCmd;
MODULE_SCOPE CompileProc TclCompileConcatCmd;
MODULE_SCOPE CompileProc TclCompileConstCmd;
MODULE_SCOPE CompileProc TclCompileContinueCmd;
MODULE_SCOPE CompileProc TclCompileDictAppendCmd;
MODULE_SCOPE CompileProc TclCompileDictCreateCmd;
MODULE_SCOPE CompileProc TclCompileDictExistsCmd;
MODULE_SCOPE CompileProc TclCompileDictForCmd;
MODULE_SCOPE CompileProc TclCompileDictGetCmd;
MODULE_SCOPE CompileProc TclCompileDictGetWithDefaultCmd;

	"upvar refers to element in deleted array";
static const char DANGLINGVAR[] =
	"upvar refers to variable in deleted namespace";
static const char BADNAMESPACE[] =	"parent namespace doesn't exist";
static const char MISSINGNAME[] =	"missing variable name";
static const char ISARRAYELEMENT[] =
	"name refers to an element in an array";
static const char ISCONST[] =		"variable is a constant";
static const char EXISTS[] =		"variable already exists";

/*
 * A test to see if we are in a call frame that has local variables. This is
 * true if we are inside a procedure body.
 */

#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)

} ArrayVarHashTable;

/*
 * Forward references to functions defined later in this file:
 */

static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks, 
			    int justConstants);
static void		ArrayPopulateSearch(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Var *varPtr,
			    ArraySearch *searchPtr);
static void		ArrayDoneSearch(Interp *iPtr, Var *varPtr,
			    ArraySearch *searchPtr);
static Tcl_NRPostProc   ArrayForLoopCallback;
static Tcl_ObjCmdProc	ArrayForNRCmd;

		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
			DANGLINGVAR, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", (void *)NULL);
	    }
	}
	goto earlyError;
    }

    /*
     * It's an error to try to set a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST,index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL);
	}
	goto earlyError;
    }

    /*
     * It's an error to try to set an array variable itself.
     */

    if (TclIsVarArray(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {

				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
				 * TCL_LEAVE_ERR_MSG. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
{
    Tcl_Obj *varValuePtr;

    /*
     * It's an error to try to increment a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST,index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL);
	}
	return NULL;
    }

    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)++;
    }
    varValuePtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
	    part2Ptr, flags, index);
    if (TclIsVarInHash(varPtr)) {

 *----------------------------------------------------------------------
 */

int
TclPtrUnsetVarIdx(
    Tcl_Interp *interp,		/* Command interpreter in which varName is to
				 * be looked up. */
    Var *varPtr,		/* The variable to be unset. */
    Var *arrayPtr,		/* NULL for scalar variables, pointer to the
				 * containing array otherwise. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags,			/* OR-ed combination of any of
				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_LEAVE_ERR_MSG. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
{
    Interp *iPtr = (Interp *) interp;
    int result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
    Var *initialArrayPtr = arrayPtr;

    /*
     * It's an error to try to unset a constant.
     */
    if (TclIsVarConstant(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST,index);
	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "CONST", (void *)NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Keep the variable alive until we're done with it. We used to
     * increase/decrease the refCount for each operation, making it hard to
     * find [Bug 735335] - caused by unsetting the variable whose value was
     * the variable's name.
     */

	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConstObjCmd --
 * 
 *	This function is invoked to process the "const" 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.
 * 
 *----------------------------------------------------------------------
 */

int
Tcl_ConstObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Var *varPtr, *arrayPtr;
    Tcl_Obj *part1Ptr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName value");
	return TCL_ERROR;
    }

    part1Ptr = objv[1];
    varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG, 
	    "const", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (TclIsVarArray(varPtr)) {
	TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", ISARRAY, -1);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (void *)NULL);
	return TCL_ERROR;
    }
    if (TclIsVarArrayElement(varPtr)) {
	if (TclIsVarUndefined(varPtr)) {
	    CleanupVar(varPtr, arrayPtr);
	}
	TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", ISARRAYELEMENT, -1);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (void *)NULL);
	return TCL_ERROR;
    }

    /*
     * If already exists, either a constant (no problem) or an error. 
     */
    if (!TclIsVarUndefined(varPtr)) {
	if (TclIsVarConstant(varPtr)) {
	    return TCL_OK;
	}
	TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", EXISTS, -1);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (void *)NULL);
	return TCL_ERROR;
    }

    /*
     * Make the variable and flag it as a constant.
     */
    if (TclPtrSetVar(interp, (Tcl_Var) varPtr, NULL, objv[1], NULL, 
	    objv[2], TCL_LEAVE_ERR_MSG) == NULL) {
	if (TclIsVarUndefined(varPtr)) {
	    CleanupVar(varPtr, arrayPtr);
	}
	return TCL_ERROR;
    };
    TclSetVarConstant(varPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GlobalObjCmd --
 *
 *	This object-based function is invoked to process the "global" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result value.

			}
		    }
		    varPtr = VarHashNextVar(&search);
		}
	    }
	}
    } else if (iPtr->varFramePtr->procPtr != NULL) {
	AppendLocals(interp, listPtr, simplePatternPtr, 1, 0);
    }

    if (simplePatternPtr) {
	Tcl_DecrRefCount(simplePatternPtr);
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;

    /*
     * Return a list containing names of first the compiled locals (i.e. the
     * ones stored in the call frame), then the variables in the local hash
     * table (if one exists).
     */

    listPtr = Tcl_NewListObj(0, NULL);
    AppendLocals(interp, listPtr, patternPtr, 0, 0);
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInfoConstsCmd --
 *
 *	Called to implement the "info consts" command that returns the list of
 *	constants in the interpreter that match an optional pattern. The
 *	pattern, if any, consists of an optional sequence of namespace names
 *	separated by "::" qualifiers, which is followed by a glob-style
 *	pattern that restricts which variables are returned. Handles the
 *	following syntax:
 *
 *	    info consts ?pattern?
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

int
TclInfoConstsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *varName, *pattern, *simplePattern;
    Tcl_HashSearch search;
    Var *varPtr;
    Namespace *nsPtr;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr, *varNamePtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_Obj *simplePatternPtr = NULL;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * variables. We only use this effective namespace if there's no active
     * Tcl procedure frame.
     */

    if (objc == 1) {
	simplePattern = NULL;
	nsPtr = currNsPtr;
	specificNsInPattern = 0;
    } else if (objc == 2) {
	/*
	 * From the pattern, get the effective namespace and the simple
	 * pattern (no namespace qualifiers or ::'s) at the end. If an error
	 * was found while parsing the pattern, return it. Otherwise, if the
	 * namespace wasn't found, just leave nsPtr NULL: we will return an
	 * empty list since no variables there can be found.
	 */

	Namespace *dummy1NsPtr, *dummy2NsPtr;

	pattern = TclGetString(objv[1]);
	TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0,
		&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);

	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
	    if (simplePattern == pattern) {
		simplePatternPtr = objv[1];
	    } else {
		simplePatternPtr = Tcl_NewStringObj(simplePattern, -1);
	    }
	    Tcl_IncrRefCount(simplePatternPtr);
	}
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
	return TCL_ERROR;
    }

    /*
     * If the namespace specified in the pattern wasn't found, just return.
     */

    if (nsPtr == NULL) {
	return TCL_OK;
    }

    listPtr = Tcl_NewListObj(0, NULL);

    if (!HasLocalVars(iPtr->varFramePtr) || specificNsInPattern) {
	/*
	 * There is no frame pointer, the frame pointer was pushed only to
	 * activate a namespace, or we are in a procedure call frame but a
	 * specific namespace was specified. Create a list containing only the
	 * variables in the effective namespace's variable table.
	 */

	if (simplePattern && TclMatchIsTrivial(simplePattern)) {
	    /*
	     * If we can just do hash lookups, that simplifies things a lot.
	     */

	    varPtr = VarHashFindVar(&nsPtr->varTable, simplePatternPtr);
	    if (varPtr && TclIsVarConstant(varPtr)) {
		if (!TclIsVarUndefined(varPtr)
			|| TclIsVarNamespaceVar(varPtr)) {
		    if (specificNsInPattern) {
			TclNewObj(elemObjPtr);
			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
				elemObjPtr);
		    } else {
			elemObjPtr = VarHashGetKey(varPtr);
		    }
		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		}
	    } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
		varPtr = VarHashFindVar(&globalNsPtr->varTable,
			simplePatternPtr);
		if (varPtr && TclIsVarConstant(varPtr)) {
		    if (!TclIsVarUndefined(varPtr)
			    || TclIsVarNamespaceVar(varPtr)) {
			Tcl_ListObjAppendElement(interp, listPtr,
				VarHashGetKey(varPtr));
		    }
		}
	    }
	} else {
	    /*
	     * Have to scan the tables of variables.
	     */

	    varPtr = VarHashFirstVar(&nsPtr->varTable, &search);
	    while (varPtr) {
		if (TclIsVarConstant(varPtr) && (!TclIsVarUndefined(varPtr)
			|| TclIsVarNamespaceVar(varPtr))) {
		    varNamePtr = VarHashGetKey(varPtr);
		    varName = TclGetString(varNamePtr);
		    if ((simplePattern == NULL)
			    || Tcl_StringMatch(varName, simplePattern)) {
			if (specificNsInPattern) {
			    TclNewObj(elemObjPtr);
			    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
				    elemObjPtr);
			} else {
			    elemObjPtr = varNamePtr;
			}
			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		    }
		}
		varPtr = VarHashNextVar(&search);
	    }

	    /*
	     * If the effective namespace isn't the global :: namespace, and a
	     * specific namespace wasn't requested in the pattern (i.e., the
	     * pattern only specifies variable names), then add in all global
	     * :: variables that match the simple pattern. Of course, add in
	     * only those variables that aren't hidden by a variable in the
	     * effective namespace.
	     */

	    if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
		varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
		while (varPtr) {
		    if (TclIsVarConstant(varPtr) && (!TclIsVarUndefined(varPtr)
			    || TclIsVarNamespaceVar(varPtr))) {
			varNamePtr = VarHashGetKey(varPtr);
			varName = TclGetString(varNamePtr);
			if ((simplePattern == NULL)
				|| Tcl_StringMatch(varName, simplePattern)) {
			    if (VarHashFindVar(&nsPtr->varTable,
				    varNamePtr) == NULL) {
				Tcl_ListObjAppendElement(interp, listPtr,
					varNamePtr);
			    }
			}
		    }
		    varPtr = VarHashNextVar(&search);
		}
	    }
	}
    } else if (iPtr->varFramePtr->procPtr != NULL) {
	AppendLocals(interp, listPtr, simplePatternPtr, 1, 1);
    }

    if (simplePatternPtr) {
	Tcl_DecrRefCount(simplePatternPtr);
    }
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AppendLocals --
 *
 *	Append the local variables for the current frame to the specified list
 *	object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ContextObjectContainsConstant(
    Tcl_ObjectContext context,
    Tcl_Obj *varNamePtr)
{
    /*
     * Helper for AppendLocals to check if an object contains a variable 
     * that is a constant. It's too complicated without factoring this 
     * check out!
     */

    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    Namespace *nsPtr = (Namespace *) oPtr->namespacePtr;
    Var *varPtr = VarHashFindVar(&nsPtr->varTable, varNamePtr);

    return !TclIsVarUndefined(varPtr) && TclIsVarConstant(varPtr);
}

static void
AppendLocals(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *listPtr,		/* List object to append names to. */
    Tcl_Obj *patternPtr,	/* Pattern to match against. */
    int includeLinks,		/* 1 if upvars should be included, else 0. */
    int justConstants)		/* 1 if just constants should be included. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_Size i, localVarCt;
    int added;
    Tcl_Obj *objNamePtr;
    const char *varName;

	for (i = 0; i < localVarCt; i++, varNamePtr++) {
	    /*
	     * Skip nameless (temporary) variables and undefined variables.
	     */

	    if (*varNamePtr && !TclIsVarUndefined(varPtr)
		    && (includeLinks || !TclIsVarLink(varPtr))) {
		varName = TclGetString(*varNamePtr);
		if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
	    	    if (!justConstants || TclIsVarConstant(varPtr)) {
			Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
		    }
		    if (includeLinks) {
			Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
		    }
		}
	    }
	    varPtr++;
	}

     */

    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
	varPtr = VarHashFindVar(localVarTablePtr, patternPtr);
	if (varPtr != NULL) {
	    if (!TclIsVarUndefined(varPtr)
		    && (includeLinks || !TclIsVarLink(varPtr))) {
		if ((!justConstants || TclIsVarConstant(varPtr))) {
		    Tcl_ListObjAppendElement(interp, listPtr,
			    VarHashGetKey(varPtr));
		}
		if (includeLinks) {
		    Tcl_CreateHashEntry(&addedTable, VarHashGetKey(varPtr),
			    &added);
		}
	    }
	}
	goto objectVars;

	    varPtr != NULL;
	    varPtr = VarHashNextVar(&search)) {
	if (!TclIsVarUndefined(varPtr)
		&& (includeLinks || !TclIsVarLink(varPtr))) {
	    objNamePtr = VarHashGetKey(varPtr);
	    varName = TclGetString(objNamePtr);
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
	    	if (!justConstants || TclIsVarConstant(varPtr)) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		}
		if (includeLinks) {
		    Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		}
	    }
	}
    }

  objectVars:
    if (!includeLinks) {
	return;
    }

    if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) {
	Tcl_ObjectContext context = (Tcl_ObjectContext) 
		iPtr->varFramePtr->clientData;
	Method *mPtr = (Method *) Tcl_ObjectContextMethod(context);

	PrivateVariableMapping *privatePtr;

	if (mPtr->declaringObjectPtr) {
	    Object *oPtr = mPtr->declaringObjectPtr;

	    FOREACH(objNamePtr, oPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		if (justConstants && !ContextObjectContainsConstant(context, 
			objNamePtr)) {
		    continue;
		}
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		}
	    }
	    FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
		Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj,
			&added);
		if (justConstants && !ContextObjectContainsConstant(context,
			privatePtr->fullNameObj)) {
		    continue;
		}
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(privatePtr->variableObj),
				pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr,
			    privatePtr->variableObj);
		}
	    }
	} else {
	    Class *clsPtr = mPtr->declaringClassPtr;

	    FOREACH(objNamePtr, clsPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		if (justConstants && !ContextObjectContainsConstant(context,
			objNamePtr)) {
		    continue;
		}
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		}
	    }
	    FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
		Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj,
			&added);
		if (justConstants && !ContextObjectContainsConstant(context,
			privatePtr->fullNameObj)) {
		    continue;
		}
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(privatePtr->variableObj),
				pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr,
			    privatePtr->variableObj);
		}
	    }
	}
    }
    Tcl_DeleteHashTable(&addedTable);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInfoConstantCmd --
 *
 *	Called to implement the "info constant" command that wests whether a
 *	specific variable is a constant. Handles the following syntax:
 *
 *	    info constant varName
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

int
TclInfoConstantCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Var *varPtr, *arrayPtr;
    int result;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName");
	return TCL_ERROR;
    }
    varPtr = TclObjLookupVar(interp, objv[1], NULL, 0, "lookup", 0, 0,
	    &arrayPtr);
    result = (varPtr && TclIsVarConstant(varPtr));
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

/*
 * Hash table implementation - first, just copy and adapt the obj key stuff
 */

void
TclInitVarHashTable(

unset functions msg

test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
    info
} -result {wrong # args: should be "info subcommand ?arg ...?"}
test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
    info gorp
} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, cmdtype, commands, complete, constant, consts, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
    info c
} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, cmdtype, commands, complete, constant, consts, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
    info l
} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, cmdtype, commands, complete, constant, consts, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
    info s
} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, cmdtype, commands, complete, constant, consts, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}

##
# ### ### ### ######### ######### #########
## info frame

## Helper
# For the more complex results we cut the file name down to remove path

test var-24.24 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    array default unset ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob

# The const command
test var-25.1 {const: no argument} -body {
    apply {{} {
	const
	return $X
    }}
} -returnCodes error -result {wrong # args: should be "const varName value"}
test var-25.2 {const: single argument} -body {
    apply {{} {
	const X
	return $X
    }}
} -returnCodes error -result {wrong # args: should be "const varName value"}
test var-25.3 {const: two arguments (basic correct usage)} {
    apply {{} {
	set res [const X gorp]
	return [list $res $X]
    }}
} {{} gorp}
test var-25.4 {const: three arguments} -body {
    apply {{} {
	const X gorp foo
	return $X
    }}
} -returnCodes error -result {wrong # args: should be "const varName value"}
test var-25.5 {const: four arguments} -body {
    apply {{} {
	const X gorp foo bar
	return $X
    }}
} -returnCodes error -result {wrong # args: should be "const varName value"}

test var-26.1 {const: unmodifiable by set} -body {
    apply {{} {
	const X 123
	set X gorp
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.2 {const: unmodifiable by append} -body {
    apply {{} {
	const X 123
	append X gorp
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.3 {const: unmodifiable by lappend} -body {
    apply {{} {
	const X 123
	lappend X gorp
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.4 {const: unmodifiable by incr} -body {
    apply {{} {
	const X 123
	incr X
    }}
} -returnCodes error -result {can't incr "X": variable is a constant}
test var-26.5 {const: unmodifiable by dict set} -body {
    apply {{} {
	const X {a 123}
	dict set X a gorp
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.6 {const: unmodifiable by regsub} -body {
    apply {{} {
	const X abcabc
	regsub -all {a(.)} $X {\1\1} X
    }}
} -returnCodes error -result {can't set "X": variable is a constant}
test var-26.7 {const: unmodifiable by gets} -setup {
    set file [makeFile foo var26.7.txt]
    set f [open $file]
} -body {
    apply {f {
	const X abcabc
	gets $f X
    }} $f
} -returnCodes error -cleanup {
    close $f
    removeFile $file
} -result {can't set "X": variable is a constant}
test var-26.8 {const: may not be array} -body {
    apply {{} {
	array set X {a b}
	const X 1
	return $X
    }}
} -returnCodes error -result {can't make constant "X": variable is array}
test var-26.9.1 {const: may not be array element} -body {
    apply {{} {
	array set X {a b}
	const X(a) 1
	return $X(a)
    }}
} -returnCodes error -result {can't make constant "X(a)": name refers to an element in an array}
test var-26.9.2 {const: may not be array element} -body {
    apply {{} {
	array set X {a b}
	const X(b) 1
	return $X(b)
    }}
} -returnCodes error -result {can't make constant "X(b)": name refers to an element in an array}
test var-26.10.1 {const: unmodifiable by const but not an error} {
    apply {{} {
	const X 1
	const X 2
	return $X
    }}
} 1
test var-26.10.2 {const: unmodifiable by const but not an error} {
    apply {{} {
	lmap x {1 2 3} {
	    const A 2
	    const B 3
	    const C 5
	    expr {$A * $x**2 + $B * $x + $C}
	}
    }}
} {10 19 32}
test var-26.11 {const: may not be unset} -body {
   apply {{} {
	const X 1
	unset X
   }}
} -returnCodes error -result {can't unset "X": variable is a constant}
test var-26.12 {const: may not be unset, but -nocomplain doesn't complain} {
   apply {{} {
	const X 1
	unset -nocomplain X
	return $X
   }}
} 1
test var-26.13 {const and traces: write trace causes fail} -body {
    apply {{} {
	trace add variable X write {apply {args {
	    error "ERR: $args"
	}}}
	const X gorp
	return $X
    }}
} -returnCodes error -result {can't set "X": ERR: X {} write}
test var-26.14 {const and traces: write trace err causes no const} -body {
    apply {{} {
	set trace {apply {args {
	    error "ERR: $args"
	}}}
	trace add variable X write $trace
	catch {
	    const X gorp
	}
	trace remove variable X write $trace
	set X 123
	return $X
    }}
} -result 123
test var-26.15 {const and traces: read traces} -setup {
    unset -nocomplain traces
    set traces {}
} -body {
    apply {{} {
	trace add variable X read {apply {args {
	    lappend ::traces $args
	}}}
	const X gorp
	list $X $X $::traces
    }}
} -result {gorp gorp {{X {} read} {X {} read}}} -cleanup {
    unset -nocomplain traces
}
test var-26.16 {const and traces: write traces} -setup {
    unset -nocomplain traces
    set traces {}
} -body {
    apply {{} {
	trace add variable X write {apply {args {
	    lappend ::traces $args
	}}}
	const X gorp
	const X foo
	catch {set X bar}
	list $X $::traces
    }}
} -result {gorp {{X {} write}}} -cleanup {
    unset -nocomplain traces
}
test var-26.17 {const and traces: unset traces} -setup {
    unset -nocomplain traces
    set traces {}
} -body {
    list {*}[apply {{} {
	trace add variable X unset {apply {args {
	    lappend ::traces $args
	}}}
	const X gorp
	unset -nocomplain X
	list $X $::traces
    }}] $traces
} -result {gorp {} {{X {} unset}}} -cleanup {
    unset -nocomplain traces
}

# Same [const], but definitely not compiled
test var-27.1 {const: unmodifiable by set} -body {
    apply {const {
	$const X 123
	set X gorp
    }} const
} -returnCodes error -result {can't set "X": variable is a constant}
test var-27.2 {const: unmodifiable by append} -body {
    apply {const {
	$const X 123
	append X gorp
    }} const
} -returnCodes error -result {can't set "X": variable is a constant}
test var-27.3 {const: unmodifiable by lappend} -body {
    apply {const {
	$const X 123
	lappend X gorp
    }} const
} -returnCodes error -result {can't set "X": variable is a constant}
test var-27.4 {const: unmodifiable by incr} -body {
    apply {const {
	$const X 123
	incr X
    }} const
} -returnCodes error -result {can't incr "X": variable is a constant}
test var-27.5 {const: unmodifiable by dict set} -body {
    apply {const {
	$const X {a 123}
	dict set X a gorp
    }} const
} -returnCodes error -result {can't set "X": variable is a constant}
test var-27.6 {const: unmodifiable by regsub} -body {
    apply {const {
	$const X abcabc
	regsub -all {a(.)} $X {\1\1} X
    }} const
} -returnCodes error -result {can't set "X": variable is a constant}
test var-27.7 {const: unmodifiable by gets} -setup {
    set file [makeFile foo var27.7.txt]
    set f [open $file]
} -body {
    apply {{const f} {
	$const X abcabc
	gets $f X
    }} const $f
} -returnCodes error -cleanup {
    close $f
    removeFile $file
} -result {can't set "X": variable is a constant}
test var-27.8 {const: may not be array} -body {
    apply {const {
	array set X {a b}
	$const X 1
	return $X
    }} const
} -returnCodes error -result {can't make constant "X": variable is array}
test var-27.9.1 {const: may not be array element} -body {
    apply {const {
	array set X {a b}
	$const X(a) 1
	return $X(a)
    }} const
} -returnCodes error -result {can't make constant "X(a)": name refers to an element in an array}
test var-27.9.2 {const: may not be array element} -body {
    apply {const {
	array set X {a b}
	$const X(b) 1
	return $X(b)
    }} const
} -returnCodes error -result {can't make constant "X(b)": name refers to an element in an array}
test var-27.10.1 {const: unmodifiable by const but not an error} {
    apply {const {
	$const X 1
	$const X 2
	return $X
    }} const
} 1
test var-27.10.2 {const: unmodifiable by const but not an error} {
    apply {const {
	lmap x {1 2 3} {
	    $const A 2
	    $const B 3
	    $const C 5
	    expr {$A * $x**2 + $B * $x + $C}
	}
    }} const
} {10 19 32}
test var-27.11 {const: may not be unset} -body {
   apply {const {
	$const X 1
	unset X
   }} const
} -returnCodes error -result {can't unset "X": variable is a constant}
test var-27.12 {const: may not be unset, but -nocomplain doesn't complain} {
   apply {const {
	$const X 1
	unset -nocomplain X
	return $X
   }} const
} 1
test var-27.13 {const and traces: write trace causes fail} -body {
    apply {const {
	trace add variable X write {apply {args {
	    error "ERR: $args"
	}}}
	$const X gorp
	return $X
    }} const
} -returnCodes error -result {can't set "X": ERR: X {} write}
test var-27.14 {const and traces: write trace err causes no const} -body {
    apply {const {
	set trace {apply {args {
	    error "ERR: $args"
	}}}
	trace add variable X write $trace
	catch {
	    $const X gorp
	}
	trace remove variable X write $trace
	set X 123
	return $X
    }} const
} -result 123
test var-27.15 {const and traces: read traces} -setup {
    unset -nocomplain traces
    set traces {}
} -body {
    apply {const {
	trace add variable X read {apply {args {
	    lappend ::traces $args
	}}}
	$const X gorp
	list $X $X $::traces
    }} const
} -result {gorp gorp {{X {} read} {X {} read}}} -cleanup {
    unset -nocomplain traces
}
test var-27.16 {const and traces: write traces} -setup {
    unset -nocomplain traces
    set traces {}
} -body {
    apply {const {
	trace add variable X write {apply {args {
	    lappend ::traces $args
	}}}
	$const X gorp
	$const X foo
	catch {set X bar}
	list $X $::traces
    }} const
} -result {gorp {{X {} write}}} -cleanup {
    unset -nocomplain traces
}
test var-27.17 {const and traces: unset traces} -setup {
    unset -nocomplain traces
    set traces {}
} -body {
    list {*}[apply {const {
	trace add variable X unset {apply {args {
	    lappend ::traces $args
	}}}
	$const X gorp
	unset -nocomplain X
	list $X $::traces
    }} const] $traces
} -result {gorp {} {{X {} unset}}} -cleanup {
    unset -nocomplain traces
}

test var-28.1 {const: in a namespace} -setup {
    namespace eval var28 {}
} -body {
    namespace eval var28 {
	variable X
	const X gorp
	return $X
    }
} -cleanup {
    namespace delete var28
} -result gorp
test var-28.2 {const: in a namespace} -setup {
    namespace eval var28 {}
} -body {
    namespace eval var28 {
	variable X
	const X gorp
    }
    apply {{} {
	variable X
	set X 123
    } var28}
} -cleanup {
    namespace delete var28
} -returnCodes error -result {can't set "X": variable is a constant}
test var-28.3 {const: in a namespace} -setup {
    namespace eval var28 {}
} -body {
    namespace eval var28 {
	variable X
	const X gorp
    }
    apply {{} {
	variable X
	unset X
    } var28}
} -cleanup {
    namespace delete var28
} -returnCodes error -result {can't unset "X": variable is a constant}
test var-28.4 {const: in a namespace} -setup {
    namespace eval var28 {}
} -body {
    namespace eval var28 {
	variable X
	const X gorp
    }
    namespace delete var28
    namespace eval var28 {
	variable X abc
    }
    apply {{} {
	variable X
	return $X
    } var28}
} -cleanup {
    namespace delete var28
} -result abc
test var-28.5 {const: in a namespace, direct access from proc} -setup {
    namespace eval var28 {}
} -body {
    set result [apply {{} {
	const ::var28::X abc
	# Constant in namespace, NOT locally!
	info exists X
    }}]
    apply {res {
	variable X
	list $res [catch {unset X} msg] $msg $X
    } var28} $result
} -cleanup {
    namespace delete var28
} -result {0 1 {can't unset "X": variable is a constant} abc}

test var-29.1 {const: globally} -setup {
    set int [interp create]
} -body {
    $int eval {
	const X gorp
	apply {{} {
	    global X
	    return $X
	}}
    }
} -cleanup {
    interp delete $int
} -result gorp
test var-29.2 {const: TclOO variable resolution} -setup {
    oo::class create Parent
} -body {
    oo::class create C {
	superclass Parent
	variable X
	constructor {} {
	    const X 123
	}
	method checkRead {} {
	    return $X
	}
	method checkWrite {} {
	    list [catch {
		set X abc
	    } msg] $msg 
	}
	method checkUnset {} {
	    list [catch {
		unset X
	    } msg] $msg 
	}
	method checkProbe {} {
	    info constant X
	}
	method checkList {} {
	    info consts
	}
    }
    set c [C new]
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Parent destroy
} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X}
test var-29.3 {const: TclOO variable resolution} -setup {
    oo::class create Parent
} -body {
    oo::class create C {
	superclass Parent
	private variable X
	constructor {} {
	    const X 123
	}
	method checkRead {} {
	    return $X
	}
	method checkWrite {} {
	    list [catch {
		set X abc
	    } msg] $msg 
	}
	method checkUnset {} {
	    list [catch {
		unset X
	    } msg] $msg 
	}
	method checkProbe {} {
	    info constant X
	}
	method checkList {} {
	    info consts
	}
    }
    set c [C new]
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Parent destroy
} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X}
test var-29.4 {const: TclOO variable resolution} -setup {
    oo::class create Parent
} -body {
    oo::class create C {
	superclass Parent
	variable X
	constructor {} {
	    set X 123
	}
	method checkRead {} {
	    return $X
	}
	method checkWrite {} {
	    list [catch {
		set X abc
	    } msg] $msg 
	}
	method checkUnset {} {
	    list [catch {
		unset X
		set X gorp
	    } msg] $msg 
	}
	method checkProbe {} {
	    info constant X
	}
	method checkList {} {
	    info consts
	}
    }
    set c [C new]
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Parent destroy
} -result {123 {0 abc} {0 gorp} 0 {}}
test var-29.5 {const: TclOO variable resolution} -setup {
    set c [oo::object create Instance]
} -body {
    oo::objdefine $c {
	variable X
	method init {} {
	    const X 123
	}
	method checkRead {} {
	    return $X
	}
	method checkWrite {} {
	    list [catch {
		set X abc
	    } msg] $msg 
	}
	method checkUnset {} {
	    list [catch {
		unset X
	    } msg] $msg 
	}
	method checkProbe {} {
	    info constant X
	}
	method checkList {} {
	    info consts
	}
    }
    $c init
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Instance destroy
} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X}
test var-29.6 {const: TclOO variable resolution} -setup {
    set c [oo::object create Instance]
} -body {
    oo::objdefine $c {
	private variable X
	method init {} {
	    const X 123
	}
	method checkRead {} {
	    return $X
	}
	method checkWrite {} {
	    list [catch {
		set X abc
	    } msg] $msg 
	}
	method checkUnset {} {
	    list [catch {
		unset X
	    } msg] $msg 
	}
	method checkProbe {} {
	    info constant X
	}
	method checkList {} {
	    info consts
	}
    }
    $c init
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Instance destroy
} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X}
test var-29.7 {const: TclOO variable resolution} -setup {
    set c [oo::object create Instance]
} -body {
    oo::objdefine $c {
	variable X
	method init {} {
	    set X 123
	}
	method checkRead {} {
	    return $X
	}
	method checkWrite {} {
	    list [catch {
		set X abc
	    } msg] $msg 
	}
	method checkUnset {} {
	    list [catch {
		unset X
		set X gorp
	    } msg] $msg 
	}
	method checkProbe {} {
	    info constant X
	}
	method checkList {} {
	    info consts
	}
    }
    $c init
    list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList]
} -cleanup {
    Instance destroy
} -result {123 {0 abc} {0 gorp} 0 {}}

# The info constant and info consts commands
test var-30.1 {info constant and info consts} {
    apply {{} {
	lappend consts [lsort [info consts]] [info constant X]
	const X 1
	lappend consts [lsort [info consts]] [info constant X]
	const Y 2
	lappend consts [lsort [info consts]]
	const X 3
	lappend consts [lsort [info consts]]
    }}
} {{} 0 X 1 {X Y} {X Y}}
test var-30.2 {info constant and info consts} {
    apply {{} {
	lappend consts [lsort [info consts X]]
	const X 1
	lappend consts [lsort [info consts X]]
	const Y 2
	lappend consts [lsort [info consts X]]
	const X 3
	lappend consts [lsort [info consts X]]
    }}
} {{} X X X}
test var-30.3 {info constant and info consts} {
    apply {{} {
	lappend consts [lsort [info consts ?]]
	const X 1
	lappend consts [lsort [info consts ?]]
	const Y 2
	lappend consts [lsort [info consts ?]]
	const XX 3
	lappend consts [lsort [info consts ?]]
    }}
} {{} X {X Y} {X Y}}
test var-30.4 {info constant and info consts} {
    apply {{} {
	lappend consts [lsort [info consts X]]
	set X 1
	lappend consts [lsort [info consts X]]
	set Y 2
	lappend consts [lsort [info consts X]]
	set X 3
	lappend consts [lsort [info consts X]]
    }}
} {{} {} {} {}}
test var-30.5 {info consts: in a namespace} -setup {
    namespace eval var30 {}
} -body {
    namespace eval var30 {
	const X gorp
	info consts
    }
} -cleanup {
    namespace delete var30
} -result X
test var-30.6 {info consts: in a namespace} -setup {
    namespace eval var30 {}
} -body {
    namespace eval var30 {
	const X gorp
	variable Y foo
    }
    info consts var30::*
} -cleanup {
    namespace delete var30
} -result ::var30::X
test var-30.7 {info constant: bad constant names: array element} {
    apply {{} {
	info constant a(b)
    }}
} 0
test var-30.8 {info constant: bad constant names: array} {
    apply {{} {
	array set a {}
	info constant a
    }}
} 0
test var-30.9 {info constant: bad constant names: no var} {
    apply {{} {
	info constant a
    }}
} 0
test var-30.10 {info constant: bad constant names: no namespace} {
    apply {{} {
	info constant ::var29::no::such::ns::a
    }}
} 0
test var-30.11 {info constant: bad constant names: dangling upvar} {
    apply {{} {
	upvar 0 no_var a
	info constant a
    }}
} 0
test var-30.12 {info constant: bad constant names: bad name} {
    apply {{} {
	info constant a(b
    }}
} 0
test var-30.13 {info constant: bad constant names: nesting} {
    apply {{} {
	array set b {c d}
	upvar 0 b(c) a
	info constant a(d)
    }}
} 0

test var-31.1 {info constant: syntax} -returnCodes error -body {
    info constant
} -result {wrong # args: should be "info constant varName"}
test var-31.2 {info constant: syntax} -returnCodes error -body {
    info constant foo bar
} -result {wrong # args: should be "info constant varName"}
test var-31.3 {info consts: syntax} -returnCodes error -body {
    info consts foo bar
} -result {wrong # args: should be "info consts ?pattern?"}

catch {namespace delete ns}
catch {unset arr}
catch {unset v}

catch {rename getbytes ""}
catch {rename p ""}