Tcl Source Code

which search on \fIarrayName\fR to destroy, and must have
been the return value from a previous invocation of
\fBarray startsearch\fR.  Returns an empty string.
.TP
\fBarray exists \fIarrayName\fR
Returns 1 if \fIarrayName\fR is an array variable, 0 if there
is no variable by that name or if it is a scalar variable.
.TP
\fBarray for {\fIkeyVariable ?valueVariable?\fB} \fIarrayName body\fR
The first argument is a one or two element list of variable names for the
key and value of each entry in the array.  The second argument is the
array name to iterate over.  The third argument is the body to execute
for each key and value returned.
The ordering of the returned keys is undefined.
.TP
\fBarray get \fIarrayName\fR ?\fIpattern\fR?
Returns a list containing pairs of elements.  The first
element in each pair is the name of an element in \fIarrayName\fR
and the second element of each pair is the value of the
array element.  The order of the pairs is undefined.
If \fIpattern\fR is not specified, then all of the elements of the

}

# TIP #400
declare 630 {
    void Tcl_ZlibStreamSetCompressionDictionary(Tcl_ZlibStream zhandle,
	    Tcl_Obj *compressionDictionaryObj)
}

# TIP #421
declare 632 {
    void Tcl_ArrayObjFirst(Tcl_Interp *interp,
	Tcl_Obj *arrayObj,
	Tcl_ArraySearch *searchPtr)
}
declare 633 {
    int Tcl_ArrayObjNext(Tcl_Interp *interp,
	Tcl_ArraySearch *searchPtr,
	Tcl_Obj **keyPtrPtr,
	Tcl_Obj **valuePtrPtr)
}

# ----- BASELINE -- FOR -- 8.6.0 ----- #

##############################################################################

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

 */

#define TCL_STRING_KEYS		(0)
#define TCL_ONE_WORD_KEYS	(1)
#define TCL_CUSTOM_TYPE_KEYS	(-2)
#define TCL_CUSTOM_PTR_KEYS	(-1)

/*
 * The following structure describes an enumerative search in progress on an
 * array variable; this are invoked with options to the "array" command.
 */

# define TCL_ARRAYSEARCH_FOR_VALUE 0x0001
typedef struct ArraySearch {
    Tcl_Obj *name;		/* Name of this search */
    int id;			/* Integer id used to distinguish among
				 * multiple concurrent searches for the same
				 * array. */
    struct Var *varPtr;		/* Pointer to array variable that's being
				 * searched. */
    Tcl_Obj *arrayNameObj; 	/* Name of the array variable in the current
                         	 * resolution context. Usually NULL except for
				 * in "array for". */
    int flags;                  /* Used by 'array for' to check if the
                                 * value is wanted. */
    Tcl_HashSearch search;	/* Info kept by the hash module about progress
				 * through the array. */
    Tcl_HashEntry *nextEntry;	/* Non-null means this is the next element to
				 * be enumerated (it's leftover from the
				 * Tcl_FirstHashEntry call or from an "array
				 * anymore" command). NULL means must call
				 * Tcl_NextHashEntry to get value to
				 * return. */
    struct ArraySearch *nextPtr;/* Next in list of all active searches for
				 * this variable, or NULL if this is the last
				 * one. */
} Tcl_ArraySearch;

/*
 * Structure definition for information used to keep track of searches through
 * dictionaries. These fields should not be accessed by code outside
 * tclDictObj.c
 */

typedef struct {

			    unsigned int pcOffset);
static int		CompileEachloopCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    CompileEnv *envPtr, int collect);
static int		CompileDictEachCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr, int collect);
static int		CompileArrayEachCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

/*
 * The structures below define the AuxData types defined in this file.
 */

static const AuxDataType foreachInfoType = {
    "ForeachInfo",		/* name */

    if (localIndex >= 0) {
	TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
    } else {
	TclEmitOpcode(	INST_ARRAY_EXISTS_STK,			envPtr);
    }
    return TCL_OK;
}

int
TclCompileArrayForCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    return CompileArrayEachCmd(interp, parsePtr, cmdPtr, envPtr);
}

int
CompileArrayEachCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr		/* Holds resulting instructions. */
    )
{
    DefineLineInformation;
    Tcl_Token *varsTokenPtr, *arrayTokenPtr, *bodyTokenPtr;
    int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
    int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
    int numVars, endTargetOffset;
    const char **argv;
    Tcl_DString buffer;

    /*
     * There must be three arguments after the command.
     */

    if (parsePtr->numWords != 4) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    varsTokenPtr = TokenAfter(parsePtr->tokenPtr);
    arrayTokenPtr = TokenAfter(varsTokenPtr);
    bodyTokenPtr = TokenAfter(arrayTokenPtr);
    if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
            arrayTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
	    bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Check we've got one or two variables and that they are local variables.
     * Then extract their indices in the LVT.
     */

    Tcl_DStringInit(&buffer);
    TclDStringAppendToken(&buffer, &varsTokenPtr[1]);
    if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
	    &argv) != TCL_OK) {
	Tcl_DStringFree(&buffer);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }
    Tcl_DStringFree(&buffer);
    /*
     * both
     *   array for {k} a {}
     *   array for {k v} a {}
     * are supported.
     */
    if (numVars != 1 && numVars != 2) {
	ckfree(argv);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    nameChars = strlen(argv[0]);
    keyVarIndex = LocalScalar(argv[0], nameChars, envPtr);
    valueVarIndex = -1;
    if (numVars == 2) {
    nameChars = strlen(argv[1]);
    valueVarIndex = LocalScalar(argv[1], nameChars, envPtr);
    }
    ckfree(argv);

    if ((keyVarIndex < 0) || (numVars == 2 && valueVarIndex < 0)) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Allocate a temporary variable to store the iterator reference. The
     * variable will contain a Tcl_ArraySearch reference which will be
     * allocated by INST_ARRAY_FIRST and disposed when the variable is unset
     * (at which point it should also have been finished with).
     */

    infoIndex = AnonymousLocal(envPtr);
    if (infoIndex < 0) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Preparation complete; issue instructions. Note that this code issues
     * fixed-sized jumps. That simplifies things a lot!
     */

    /*
     * Get the array and start the iteration. No catching of errors at
     * this point.
     */

    CompileWord(envPtr, arrayTokenPtr, interp, 2);

    /*
     * Now we catch errors from here on
     */

    TclEmitInstInt4(	INST_ARRAY_FIRST, infoIndex,		envPtr);

    catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    TclEmitInstInt4(	INST_BEGIN_CATCH4, catchRange,		envPtr);
    ExceptionRangeStarts(envPtr, catchRange);

    /*
     * Set up the loop exception targets.
     */

    loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
    ExceptionRangeStarts(envPtr, loopRange);

    /*
     * Inside the iteration, fetch and write the loop variables.
     */

    bodyTargetOffset = CurrentOffset(envPtr);

    TclEmitInstInt4(	INST_ARRAY_NEXT, infoIndex,		envPtr);
    emptyTargetOffset = CurrentOffset(envPtr);

    Emit14Inst(		INST_STORE_SCALAR, keyVarIndex,		envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);
    if (valueVarIndex != -1) {
	Emit14Inst(		INST_STORE_SCALAR, valueVarIndex,	envPtr);
    }
    TclEmitOpcode(	INST_POP,				envPtr);

    /*
     * Compile the loop body itself. It should be stack-neutral.
     */

    BODY(bodyTokenPtr, 3);
    TclEmitOpcode(	INST_POP, 				envPtr);

    /*
     * Both exception target ranges (error and loop) end here.
     */

    ExceptionRangeEnds(envPtr, loopRange);
    ExceptionRangeEnds(envPtr, catchRange);

    /*
     * Continue (or just normally process) by getting the next pair of items
     * from the dictionary and jumping back to the code to write them into
     * variables if there is another pair.
     */

    TclAdjustStackDepth(-1, envPtr);
    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
    TclEmitInstInt4(	INST_ARRAY_NEXT, infoIndex,		envPtr);
    jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
    /*
     * checks the 'done' boolean on the stack and if false,
     * goes back to the top of the loop
     */
    TclEmitInstInt4(	INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
    endTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt1(	INST_JUMP1, 0,				envPtr);

    /*
     * Error handler "finally" clause, which force-terminates the iteration
     * and rethrows the error.
     */

    ExceptionRangeTarget(envPtr, catchRange, catchOffset);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(		infoIndex,			envPtr);
    TclEmitOpcode(	INST_RETURN_STK,			envPtr);

    /*
     * Otherwise we're done and we
     * need to pop the bogus key/value pair (pushed to keep stack calculations
     * easy!) Note that we skip the END_CATCH. [Bug 1382528]
     */

    jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
    TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
	    envPtr->codeStart + emptyTargetOffset);
    jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset;
    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDisplacement,
	    envPtr->codeStart + endTargetOffset);
    TclEmitOpcode(	INST_POP,				envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);
    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
    TclFinalizeLoopExceptionRange(envPtr, loopRange);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);

    /*
     * Final stage of the command (normal case) is that we push an empty
     * object (or push the accumulator as the result object). This is done
     * last to promote peephole optimization when it's dropped immediately.
     */

    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(		infoIndex,			envPtr);
    PushStringLiteral(envPtr, "");
    return TCL_OK;
}


int
TclCompileArraySetCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being

    {"arrayMakeStk",	 1,	-1,	  0,	{OPERAND_NONE}},
	/* Forces the element on the top of the stack to be the name of an
	 * array.
	 * Stack:  ... varName => ... */
    {"arrayMakeImm",	 5,	0,	  1,	{OPERAND_LVT4}},
	/* Forces the variable indexed by opnd to be an array. Does not touch
	 * the stack. */

    {"invokeReplace",	 6,	INT_MIN,  2,	{OPERAND_UINT4,OPERAND_UINT1}},
	/* Invoke command named objv[0], replacing the first two words with
	 * the word at the top of the stack;
	 * <objc,objv> = <op4,top op4 after popping 1> */

    {"listConcat",	 1,	-1,	  0,	{OPERAND_NONE}},
	/* Concatenates the two lists at the top of the stack into a single

	 * Stack:  ... elem list => ... listVarContents */
    {"lappendListArrayStk", 1,	-2,	0,	{OPERAND_NONE}},
	/* Lappend list to array element.
	 * Stack:  ... arrayName elem list => ... listVarContents */
    {"lappendListStk",	 1,	-1,	0,	{OPERAND_NONE}},
	/* Lappend list to general variable.
	 * Stack:  ... varName list => ... listVarContents */
    {"arrayFirst",	 5,	0,	  1,	{OPERAND_LVT4}},
        /* Set up iteration over the array
         * no stack effect */
    {"arrayNext",	 5,	+3,	  1,	{OPERAND_LVT4}},
        /* Stack: key value done */
    {NULL, 0, 0, 0, {OPERAND_NONE}}
};

/*
 * Prototypes for procedures defined later in this file:
 */

#define INST_STR_CLASS			184

#define INST_LAPPEND_LIST		185
#define INST_LAPPEND_LIST_ARRAY		186
#define INST_LAPPEND_LIST_ARRAY_STK	187
#define INST_LAPPEND_LIST_STK		188

#define INST_ARRAY_FIRST		189
#define INST_ARRAY_NEXT			190

/* The last opcode */
#define LAST_INST_OPCODE		190

/*
 * Table describing the Tcl bytecode instructions: their name (for displaying
 * code), total number of code bytes required (including operand bytes), and a
 * description of the type of each operand. These operand types include signed
 * and unsigned integers of length one and four bytes. The unsigned integers
 * are used for indexes or for, e.g., the count of objects to push in a "push"

    (envPtr)->currStackDepth = (depth)

#define TclCheckStackDepth(depth, envPtr)				\
    do {								\
	int dd = (depth);						\
	if (dd != (envPtr)->currStackDepth) {				\
	    Tcl_Panic("bad stack depth computations: is %i, should be %i", \
		    (envPtr)->currStackDepth, dd); \
	}								\
    } while (0)

/*
 * Macro used to update the stack requirements. It is called by the macros
 * TclEmitOpCode, TclEmitInst1 and TclEmitInst4.
 * Remark that the very last instruction of a bytecode always reduces the

/* 629 */
EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
				Tcl_LoadHandle handlePtr);
/* 630 */
EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
				Tcl_ZlibStream zhandle,
				Tcl_Obj *compressionDictionaryObj);
/* Slot 631 is reserved */
/* 632 */
EXTERN void		Tcl_ArrayObjFirst(Tcl_Interp *interp,
				Tcl_Obj *arrayObj,
				Tcl_ArraySearch *searchPtr);
/* 633 */
EXTERN int		Tcl_ArrayObjNext(Tcl_Interp *interp,
				Tcl_ArraySearch *searchPtr,
				Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

    int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */
    int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
    int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
    int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
    void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
    int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
    void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
    void (*reserved631)(void);
    void (*tcl_ArrayObjFirst) (Tcl_Interp *interp, Tcl_Obj *arrayObj, Tcl_ArraySearch *searchPtr); /* 632 */
    int (*tcl_ArrayObjNext) (Tcl_Interp *interp, Tcl_ArraySearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr); /* 633 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif

	(tclStubsPtr->tcl_LoadFile) /* 627 */
#define Tcl_FindSymbol \
	(tclStubsPtr->tcl_FindSymbol) /* 628 */
#define Tcl_FSUnloadFile \
	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
#define Tcl_ZlibStreamSetCompressionDictionary \
	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
/* Slot 631 is reserved */
#define Tcl_ArrayObjFirst \
	(tclStubsPtr->tcl_ArrayObjFirst) /* 632 */
#define Tcl_ArrayObjNext \
	(tclStubsPtr->tcl_ArrayObjNext) /* 633 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp

static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
			    int move);
static void		IllegalExprOperandType(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj *opndPtr);
static void		InitByteCodeExecution(Tcl_Interp *interp);
static inline int	wordSkip(void *ptr);
static void		ReleaseDictIterator(Tcl_Obj *objPtr);
static void		ReleaseArrayIterator(Tcl_Obj *objPtr);
/* Useful elsewhere, make available in tclInt.h or stubs? */
static Tcl_Obj **	StackAllocWords(Tcl_Interp *interp, int numWords);
static Tcl_Obj **	StackReallocWords(Tcl_Interp *interp, int numWords);
static Tcl_NRPostProc	CopyCallback;
static Tcl_NRPostProc	ExprObjCallback;
static Tcl_NRPostProc	FinalizeOONext;
static Tcl_NRPostProc	FinalizeOONextFilter;

 * be seen by user scripts.
 */

static const Tcl_ObjType dictIteratorType = {
    "dictIterator",
    ReleaseDictIterator,
    NULL, NULL, NULL
};
static const Tcl_ObjType arrayIteratorType = {
    "arrayIterator",
    ReleaseArrayIterator,
    NULL, NULL, NULL
};

/*
 *----------------------------------------------------------------------
 *
 * ReleaseDictIterator --
 *

    searchPtr = objPtr->internalRep.twoPtrValue.ptr1;
    Tcl_DictObjDone(searchPtr);
    ckfree(searchPtr);

    dictPtr = objPtr->internalRep.twoPtrValue.ptr2;
    TclDecrRefCount(dictPtr);

    objPtr->typePtr = NULL;
}


/*
 *----------------------------------------------------------------------
 *
 * ReleaseArrayIterator --
 *
 *	This takes apart an array iterator that is stored in the given Tcl
 *	object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deallocates memory, marks the object as being untyped.
 *
 *----------------------------------------------------------------------
 */

static void
ReleaseArrayIterator(
    Tcl_Obj *objPtr)
{
    Tcl_ArraySearch *searchPtr;
    Tcl_Obj *arrayPtr;

    /*
     * First kill the search, and then release the reference to the dictionary
     * that we were holding.
     */

    searchPtr = objPtr->internalRep.twoPtrValue.ptr1;
    ckfree(searchPtr);

    arrayPtr = objPtr->internalRep.twoPtrValue.ptr2;
    TclDecrRefCount(arrayPtr);

    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * InitByteCodeExecution --

	if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
	    objResultPtr = TCONST(1);
	} else {
	    objResultPtr = TCONST(0);
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(pcAdjustment, cleanup, 1);

    {
	int done;
	Tcl_Obj *arrayObj, *statePtr, *keyPtr, *valuePtr;
	Tcl_Obj *emptyPtr;
	Tcl_ArraySearch *searchPtr;

    case INST_ARRAY_FIRST:
        pcAdjustment = 1;
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	arrayObj = POP_OBJECT();
	searchPtr = ckalloc(sizeof(Tcl_ArraySearch));
	Tcl_ArrayObjFirst(interp, arrayObj, searchPtr);
	TclNewObj(statePtr);
	statePtr->typePtr = &arrayIteratorType;
	statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
	statePtr->internalRep.twoPtrValue.ptr2 = arrayObj;
	varPtr = LOCAL(opnd);
	if (varPtr->value.objPtr) {
	    if (varPtr->value.objPtr->typePtr == &arrayIteratorType) {
		Tcl_Panic("mis-issued arrayFirst!");
	    }
	    TclDecrRefCount(varPtr->value.objPtr);
	}
	varPtr->value.objPtr = statePtr;
	Tcl_IncrRefCount(statePtr);
	NEXT_INST_F(1, 0, 0); /*### ??? */

    case INST_ARRAY_NEXT:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	statePtr = (*LOCAL(opnd)).value.objPtr;
	if (statePtr == NULL || statePtr->typePtr != &arrayIteratorType) {
	    Tcl_Panic("mis-issued dictNext!");
	}
	searchPtr = statePtr->internalRep.twoPtrValue.ptr1;
	done = Tcl_ArrayObjNext(interp, searchPtr, &keyPtr, &valuePtr);
	if (done) {
	    TclNewObj(emptyPtr);
	    PUSH_OBJECT(emptyPtr);
	    PUSH_OBJECT(emptyPtr);
	} else {
	    if (valuePtr != NULL) {
		PUSH_OBJECT(valuePtr);
	    } else {
		PUSH_OBJECT(emptyPtr);
	    }
	    PUSH_OBJECT(keyPtr);
	}
	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
	JUMP_PEEPHOLE_F(done, 5, 0); /* ### ??? */
    }

    case INST_ARRAY_MAKE_IMM:
	opnd = TclGetUInt4AtPtr(pc+1);
	pcAdjustment = 5;
	cleanup = 0;
	part1Ptr = NULL;
	arrayPtr = NULL;

 */

MODULE_SCOPE int	TclCompileAppendCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileArrayExistsCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileArrayForCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileArraySetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileArrayUnsetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

    Tcl_CloseEx, /* 624 */
    Tcl_NRExprObj, /* 625 */
    Tcl_NRSubstObj, /* 626 */
    Tcl_LoadFile, /* 627 */
    Tcl_FindSymbol, /* 628 */
    Tcl_FSUnloadFile, /* 629 */
    Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
    0, /* 631 */
    Tcl_ArrayObjFirst, /* 632 */
    Tcl_ArrayObjNext, /* 633 */
};

/* !END!: Do not edit above this line. */

/*
 * 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)


























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

static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks);
static Tcl_NRPostProc	ArrayForLoopCallback;
static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
			    Var *varPtr, int flags, int index);
static Tcl_Var		ObjFindNamespaceVar(Tcl_Interp *interp,
			    Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr,
			    int flags);
static int		ObjMakeUpvar(Tcl_Interp *interp,
			    CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
			    const char *otherP2, const int otherFlags,
			    Tcl_Obj *myNamePtr, int myFlags, int index);
static Tcl_ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
			    Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
			    Interp *iPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int flags, int index);
static Var *		VerifyArray(Tcl_Interp *interp, Tcl_Obj *varNameObj);

/*

    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayForNRCmd --
 * ArrayForLoopCallback
 *
 *	These functions implement the "array for" Tcl command.
 *    array for {k} a {}
 *    array for {k v} a {}
 *  The array for command iterates over the array, setting the
 *  the specified loop variables, and executing the body each iteration.
 *
 *  ArrayForNRCmd() sets up the Tcl_ArraySearch structure, sets arrayNamePtr
 *  inside the structure and calls VarHashFirstEntry to start the hash
 *  iteration.
 *
 *  ArrayForNRCmd() does not execute the body or set the loop variables,
 *  it only initializes the iterator.
 *
 *  ArrayForLoopCallback() iterates over the entire array, executing
 *  the body each time.
 *
 *----------------------------------------------------------------------
 */

static int
ArrayForNRCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
    Tcl_Obj **varv;
    Tcl_Obj *arrayNameObj;
    Tcl_ArraySearch *searchPtr = NULL;
    Var *varPtr;
    Var *arrayPtr;
    int varc;

    /*
     * array for {k} a body
     * array for {k v} a body
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"{keyVarName ?valueVarName?} array script");
	return TCL_ERROR;
    }

    /*
     * Parse arguments.
     */

    if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
	return TCL_ERROR;
    }
    if (varc < 1 || varc > 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have one or two variable names", -1));
	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", NULL);
	return TCL_ERROR;
    }

    arrayNameObj = objv[2];
    keyVarObj = varv[0];
    valueVarObj = (varc < 2 ? NULL : varv[1]);
    scriptObj = objv[3];

    /*
     * Locate the array variable.
     */

    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
     */

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, arrayNameObj, NULL,
		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
	    return TCL_ERROR;
	}
    }

    /*
     * Verify that it is indeed an array variable. This test comes after the
     * traces; the variable may actually become an array as an effect of said
     * traces.
     */

    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
	    || TclIsVarUndefined(varPtr)) {
	const char *varName = Tcl_GetString(arrayNameObj);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't an array", varName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
	return TCL_ERROR;
    }

    /*
     * Make a new array search, put it on the stack.
     */

    searchPtr = TclStackAlloc(interp, sizeof(Tcl_ArraySearch));
    Tcl_ArrayObjFirst(interp, arrayNameObj, searchPtr);

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish.
     */

    Tcl_IncrRefCount(keyVarObj);
    if (valueVarObj != NULL) {
	Tcl_IncrRefCount(valueVarObj);
    }
    Tcl_IncrRefCount(scriptObj);

    /*
     * Run the script.
     */

    TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, keyVarObj,
	    valueVarObj, scriptObj);
    return TCL_OK;
}

/*
 * Tcl_ArrayObjFirst
 *
 * Does not execute the body or set the key/value variables.
 *
 */
void
Tcl_ArrayObjFirst(
    Tcl_Interp *interp,
    Tcl_Obj *arrayObj,
    Tcl_ArraySearch *searchPtr)
{
    Var *varPtr;
    Var *arrayPtr;

    searchPtr->id = 1;
    /*
     * Do not turn on VAR_SEARCH_ACTIVE in varPtr->flags. This search is not
     * stored in the search list.
     */
    searchPtr->nextPtr = NULL;
    varPtr = TclObjLookupVarEx(interp, arrayObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
    searchPtr->varPtr = varPtr;
    searchPtr->arrayNameObj = arrayObj;
    searchPtr->flags = TCL_ARRAYSEARCH_FOR_VALUE;
    searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
	    &searchPtr->search);
}

int
Tcl_ArrayObjNext(
    Tcl_Interp *interp,
    Tcl_ArraySearch *searchPtr,
    Tcl_Obj **keyPtrPtr,	/* Pointer to a variable to have the key
				 * written into, or NULL. */
    Tcl_Obj **valuePtrPtr	/* Pointer to a variable to have the
				 * value written into, or NULL.*/
    )
{
    Tcl_Obj *keyObj;
    Tcl_Obj *valueObj = NULL;
    Var     *varPtr;
    int     gotValue;
    int     donerc;

    donerc = 1;

    gotValue = 0;
    while (1) {
	Tcl_HashEntry *hPtr = searchPtr->nextEntry;

	/*
	 * The only time hPtr will be non-NULL is when first started.
	 * nextEntry is set by the Tcl_FirstHashEntry call in the
	 * call to Tcl_ArrayObjFirst from ArrayForNRCmd.
	 */

	if (hPtr != NULL) {
	    searchPtr->nextEntry = NULL;
	} else {
	    hPtr = Tcl_NextHashEntry(&searchPtr->search);
	    if (hPtr == NULL) {
		gotValue = 0;
		break;
	    }
	}
	varPtr = VarHashGetValue(hPtr);
	if (!TclIsVarUndefined(varPtr)) {
	    gotValue = 1;
	    break;
	}
    }

    if (!gotValue) {
	donerc = 1;
	return donerc;
    }

    donerc = 0;

    keyObj = VarHashGetKey(varPtr);
    *keyPtrPtr = keyObj;
    *valuePtrPtr = NULL;
    if (searchPtr->flags & TCL_ARRAYSEARCH_FOR_VALUE) {
	valueObj = Tcl_ObjGetVar2(interp, searchPtr->arrayNameObj,
                keyObj, TCL_LEAVE_ERR_MSG);
        *valuePtrPtr = valueObj;
    }

    return donerc;
}

static int
ArrayForLoopCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_ArraySearch *searchPtr = data[0];
    Tcl_Obj *keyObj, *valueObj;
    Tcl_Obj *keyVarObj = data[1];
    Tcl_Obj *valueVarObj = data[2];
    Tcl_Obj *scriptObj = data[3];
    int done;

    /*
     * Process the result from the previous execution of the script body.
     */

    if (result == TCL_CONTINUE) {
	result = TCL_OK;
    } else if (result != TCL_OK) {
	if (result == TCL_BREAK) {
	    Tcl_ResetResult(interp);
	    result = TCL_OK;
	} else if (result == TCL_ERROR) {
	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		    "\n    (\"array for\" body line %d)",
		    Tcl_GetErrorLine(interp)));
	}
	goto done;
    }

    /*
     * Get the next mapping from the array.
     */

    keyObj = NULL;
    valueObj = NULL;
    if (valueVarObj != NULL) {
      valueObj = Tcl_NewObj();
    }
    done = Tcl_ArrayObjNext (interp, searchPtr, &keyObj, &valueObj);

    result = TCL_OK;
    if (done) {
	Tcl_ResetResult(interp);
	goto done;
    }
    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {
      result = TCL_ERROR;
      goto done;
    }
    if (valueVarObj != NULL) {
      if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
        result = TCL_ERROR;
        goto done;
      }
    }

    /*
     * Run the script.
     */

    TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, keyVarObj,
	    valueVarObj, scriptObj);
    return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);

    /*
     * For unwinding everything once the iterating is done.
     */

  done:
    TclDecrRefCount(keyVarObj);
    if (valueVarObj != NULL) {
	TclDecrRefCount(valueVarObj);
    }
    TclDecrRefCount(scriptObj);
    TclStackFree(interp, searchPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayStartSearchCmd --
 *
 *	This object-based function is invoked to process the "array
 *	startsearch" Tcl command. See the user documentation for details on
 *	what it does.
 *
 * Results:

    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_HashEntry *hPtr;
    int isNew;
    Tcl_ArraySearch *searchPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }

    varPtr = VerifyArray(interp, objv[1]);
    if (varPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Make a new array search with a free name.
     */

    searchPtr = ckalloc(sizeof(Tcl_ArraySearch));
    hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
    if (isNew) {
	searchPtr->id = 1;
	varPtr->flags |= VAR_SEARCH_ACTIVE;
	searchPtr->nextPtr = NULL;
    } else {
	searchPtr->id = ((Tcl_ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
	searchPtr->nextPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr);
    }
    searchPtr->varPtr = varPtr;
    searchPtr->arrayNameObj = NULL;
    searchPtr->flags = 0;
    searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
	    &searchPtr->search);
    Tcl_SetHashValue(hPtr, searchPtr);
    searchPtr->name = Tcl_ObjPrintf("s-%d-%s", searchPtr->id, TclGetString(objv[1]));
    Tcl_IncrRefCount(searchPtr->name);
    Tcl_SetObjResult(interp, searchPtr->name);
    return TCL_OK;

    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    int gotValue;
    Tcl_ArraySearch *searchPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    Tcl_ArraySearch *searchPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_HashEntry *hPtr;
    Tcl_Obj *varNameObj, *searchObj;
    Tcl_ArraySearch *searchPtr, *prevPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    /*
     * Unhook the search from the list of searches associated with the
     * variable.
     */

    hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
    if (searchPtr == (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr)) {
	if (searchPtr->nextPtr) {
	    Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
	} else {
	    varPtr->flags &= ~VAR_SEARCH_ACTIVE;
	    Tcl_DeleteHashEntry(hPtr);
	}
    } else {
	for (prevPtr= (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
	    if (prevPtr->nextPtr == searchPtr) {
		prevPtr->nextPtr = searchPtr->nextPtr;
		break;
	    }
	}
    }
    Tcl_DecrRefCount(searchPtr->name);

TclInitArrayCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap arrayImplMap[] = {
	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
	{"for",		NULL,			TclCompileArrayForCmd, ArrayForNRCmd, NULL, 0},
	{"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"names",	ArrayNamesCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"set",		ArraySetCmd,		TclCompileArraySetCmd, NULL, NULL, 0},
	{"size",	ArraySizeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"startsearch",	ArrayStartSearchCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"statistics",	ArrayStatsCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},

 *	The return value is a pointer to the array search indicated by string,
 *	or NULL if there isn't one. If NULL is returned, the interp's result
 *	contains an error message.
 *
 *----------------------------------------------------------------------
 */

static Tcl_ArraySearch *
ParseSearchId(
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const Var *varPtr,		/* Array variable search is for. */
    Tcl_Obj *varNamePtr,	/* Name of array variable that search is
				 * supposed to be for. */
    Tcl_Obj *handleObj)		/* Object containing id of search. Must have
				 * form "search-num-var" where "num" is a
				 * decimal number and "var" is a variable
				 * name. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_ArraySearch *searchPtr;
    const char *handle = TclGetString(handleObj);
    char *end;

    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
	Tcl_HashEntry *hPtr =
		Tcl_FindHashEntry(&iPtr->varSearches, varPtr);

	/* First look for same (Tcl_Obj *) */
	for (searchPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr); searchPtr != NULL;
		searchPtr = searchPtr->nextPtr) {
	    if (searchPtr->name == handleObj) {
		return searchPtr;
	    }
	}
	/* Fallback: do string compares. */
	for (searchPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr); searchPtr != NULL;
		searchPtr = searchPtr->nextPtr) {
	    if (strcmp(TclGetString(searchPtr->name), handle) == 0) {
		return searchPtr;
	    }
	}
    }
    if ((handle[0] != 's') || (handle[1] != '-')

static void
DeleteSearches(
    Interp *iPtr,
    register Var *arrayVarPtr)	/* Variable whose searches are to be
				 * deleted. */
{
    Tcl_ArraySearch *searchPtr, *nextPtr;
    Tcl_HashEntry *sPtr;

    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
	for (searchPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(sPtr); searchPtr != NULL;
		searchPtr = nextPtr) {
	    nextPtr = searchPtr->nextPtr;
	    Tcl_DecrRefCount(searchPtr->name);
	    ckfree(searchPtr);
	}
	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
	Tcl_DeleteHashEntry(sPtr);

    }
    foo
} {1 {"x" isn't an array}}
test set-old-8.6 {array command} {
    catch {unset a}
    set a(22) 3
    list [catch {array gorp a} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
test set-old-8.7 {array command, anymore option} {
    catch {unset a}
    list [catch {array anymore a x} msg] $msg
} {1 {"a" isn't an array}}
test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
    proc foo {x} {
        if {$x==1} {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

verbose [list line error skip start]

testConstraint testupvar [llength [info commands testupvar]]
testConstraint testgetvarfullname [llength [info commands testgetvarfullname]]
testConstraint testsetnoerr [llength [info commands testsetnoerr]]
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {

test var-22.2 {leak in parsedVarName} -constraints memory -body {
    set i 0
    leaktest {lappend x($i)}
} -cleanup {
    unset -nocomplain i x
} -result 0

unset -nocomplain a k v
test var-23.1 {array command, for loop} -returnCodes error -body {
    array for {k v} c d e {}
} -result {wrong # args: should be "array for {keyVarName ?valueVarName?} array script"}
test var-23.2 {array command, for loop} -returnCodes error -body {
    array for d {}
} -result {wrong # args: should be "array for {keyVarName ?valueVarName?} array script"}
test var-23.3 {array command, for loop, wrong # of list args} -setup {
    unset -nocomplain a
} -returnCodes error -body {
    array for {k v w} a {}
} -result {must have one or two variable names}
test var-23.4 {array command, for loop, no array} -setup {
    unset -nocomplain a
} -returnCodes error -body {
    array for {k v} a {}
} -result {"a" isn't an array}
test var-23.5 {array command, for loop, array doesn't exist yet but has compiler-allocated procedure slot} -setup {
    catch {rename p ""}
} -returnCodes error -body {
    apply {{x} {
        if {$x==1} {
            return [array for {k v} a {}]
        }
        set a(x) 123
    }} 1
} -result {"a" isn't an array}
test var-23.6 {array enumeration} -setup {
    unset -nocomplain a
    unset -nocomplain reslist
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k v} a {
	lappend reslist $k $v
    }
    # if someone turns on varPtr->flags |= VAR_SEARCH_ACTIVE
    # a segmentation violation will result.
    unset a;		# this should not cause a segmentation violation.
    # there is no guarantee in which order the array contents will be
    # returned.
    lsort -stride 2 -index 0 $reslist
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {a 1 b 2 c 3}
test var-23.7 {array enumeration, without value} -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k} a {
	lappend reslist $k
    }
    # there is no guarantee in which order the array contents will be
    # returned.
    lsort $reslist
} -result {a b c}
test var-23.8 {array enumeration, nested} -setup {
    unset -nocomplain a
    unset -nocomplain reslist
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k1 v1} a {
	lappend reslist $k1 $v1
	set r2 {}
	array for {k2 v2} a {
	    lappend r2 $k2 $v2
	}
	lappend reslist [lsort -stride 2 -index 0 $r2]
    }
    # there is no guarantee in which order the array contents will be
    # returned.
    lsort -stride 3 -index 0 $reslist
} -result {a 1 {a 1 b 2 c 3} b 2 {a 1 b 2 c 3} c 3 {a 1 b 2 c 3}}
test var-23.9 {array enumeration, continue} -setup {
    unset -nocomplain a
    unset -nocomplain reslist
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k v} a {
	if { $k eq {b} } {
	    continue
	}
	lappend reslist $k $v
    }
    # there is no guarantee in which order the array contents will be
    # returned.
    lsort -stride 2 -index 0 $reslist
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {a 1 c 3}
test var-23.10 {array enumeration, break} -setup {
    unset -nocomplain a
    unset -nocomplain reslist
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k v} a {
	if { $k eq {b} } {
	    break
	}
	lappend reslist $k $v
    }
    # there is no guarantee in which order the array contents will be
    # returned.
    lsort -stride 2 -index 0 $reslist
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {a 1}

catch {namespace delete ns}
catch {unset arr}
catch {unset v}

catch {rename getbytes ""}
catch {rename p ""}
catch {namespace delete test_ns_var}
catch {namespace delete test_ns_var2}
catch {unset xx}
catch {unset x}
catch {unset y}
catch {unset i}
catch {unset a}
catch {unset reslist}
catch {unset xxxxx}
catch {unset aaaaa}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End: