Merge trunk

doc/array.n

@@ -47,6 +47,13 @@ been the return value from a previous invocation of
 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

generic/tcl.decls

@@ -2324,6 +2324,19 @@ declare 630 {
 	    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 ----- #
 
 ##############################################################################

generic/tcl.h

@@ -1334,6 +1334,37 @@ typedef struct Tcl_HashSearch {
 #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

generic/tclCompCmds.c

@@ -49,6 +49,9 @@ static int		CompileEachloopCmd(Tcl_Interp *interp,
 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.
@@ -287,6 +290,221 @@ TclCompileArrayExistsCmd(
     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. */

generic/tclCompile.c

@@ -522,7 +522,6 @@ InstructionDesc const tclInstructionTable[] = {
     {"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;
@@ -653,7 +652,11 @@ InstructionDesc const tclInstructionTable[] = {
     {"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}}
 };
 

generic/tclCompile.h

@@ -821,8 +821,11 @@ typedef struct ByteCode {
 #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		188
+#define LAST_INST_OPCODE		190
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
@@ -1241,7 +1244,7 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 	int dd = (depth);						\
 	if (dd != (envPtr)->currStackDepth) {				\
 	    Tcl_Panic("bad stack depth computations: is %i, should be %i", \
-		    (envPtr)->currStackDepth, dd);		\
+		    (envPtr)->currStackDepth, dd); \
 	}								\
     } while (0)
 

generic/tclDecls.h

@@ -1816,6 +1816,15 @@ EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
 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;
@@ -2482,6 +2491,9 @@ typedef struct TclStubs {
     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;
@@ -3774,6 +3786,11 @@ extern const TclStubs *tclStubsPtr;
 	(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) */
 

generic/tclExecute.c

@@ -766,6 +766,7 @@ static void		IllegalExprOperandType(Tcl_Interp *interp,
 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);
@@ -798,6 +799,11 @@ static const Tcl_ObjType dictIteratorType = {
     ReleaseDictIterator,
     NULL, NULL, NULL
 };
+static const Tcl_ObjType arrayIteratorType = {
+    "arrayIterator",
+    ReleaseArrayIterator,
+    NULL, NULL, NULL
+};
 
 /*
  *----------------------------------------------------------------------
@@ -837,6 +843,45 @@ ReleaseDictIterator(
 
     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;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -4180,6 +4225,60 @@ TEBCresume(
 	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;

generic/tclInt.h

@@ -3499,6 +3499,9 @@ MODULE_SCOPE int	TclCompileAppendCmd(Tcl_Interp *interp,
 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);

generic/tclStubInit.c

@@ -1416,6 +1416,9 @@ const TclStubs tclStubs = {
     Tcl_FindSymbol, /* 628 */
     Tcl_FSUnloadFile, /* 629 */
     Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
+    0, /* 631 */
+    Tcl_ArrayObjFirst, /* 632 */
+    Tcl_ArrayObjNext, /* 633 */
 };
 
 /* !END!: Do not edit above this line. */

generic/tclVar.c

@@ -143,37 +143,13 @@ static const char *isArrayElement =
 
 #define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)
 
-/*
- * The following structure describes an enumerative search in progress on an
- * array variable; this are invoked with options to the "array" command.
- */
-
-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_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. */
-} ArraySearch;
-
 /*
  * 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);
@@ -184,7 +160,7 @@ 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 ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
+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,
@@ -2828,6 +2804,315 @@ TclArraySet(
     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;
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -2905,7 +3190,7 @@ ArrayStartSearchCmd(
     Var *varPtr;
     Tcl_HashEntry *hPtr;
     int isNew;
-    ArraySearch *searchPtr;
+    Tcl_ArraySearch *searchPtr;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
@@ -2921,17 +3206,19 @@ ArrayStartSearchCmd(
      * Make a new array search with a free name.
      */
 
-    searchPtr = ckalloc(sizeof(ArraySearch));
+    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 = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
-	searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
+	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);
@@ -2970,7 +3257,7 @@ ArrayAnyMoreCmd(
     Var *varPtr;
     Tcl_Obj *varNameObj, *searchObj;
     int gotValue;
-    ArraySearch *searchPtr;
+    Tcl_ArraySearch *searchPtr;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
@@ -3044,7 +3331,7 @@ ArrayNextElementCmd(
 {
     Var *varPtr;
     Tcl_Obj *varNameObj, *searchObj;
-    ArraySearch *searchPtr;
+    Tcl_ArraySearch *searchPtr;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
@@ -3123,7 +3410,7 @@ ArrayDoneSearchCmd(
     Var *varPtr;
     Tcl_HashEntry *hPtr;
     Tcl_Obj *varNameObj, *searchObj;
-    ArraySearch *searchPtr, *prevPtr;
+    Tcl_ArraySearch *searchPtr, *prevPtr;
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
@@ -3152,7 +3439,7 @@ ArrayDoneSearchCmd(
      */
 
     hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
-    if (searchPtr == Tcl_GetHashValue(hPtr)) {
+    if (searchPtr == (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr)) {
 	if (searchPtr->nextPtr) {
 	    Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
 	} else {
@@ -3160,7 +3447,7 @@ ArrayDoneSearchCmd(
 	    Tcl_DeleteHashEntry(hPtr);
 	}
     } else {
-	for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
+	for (prevPtr= (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
 	    if (prevPtr->nextPtr == searchPtr) {
 		prevPtr->nextPtr = searchPtr->nextPtr;
 		break;
@@ -4026,6 +4313,7 @@ TclInitArrayCmd(
 	{"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},
@@ -4820,7 +5108,7 @@ Tcl_UpvarObjCmd(
  *----------------------------------------------------------------------
  */
 
-static ArraySearch *
+static Tcl_ArraySearch *
 ParseSearchId(
     Tcl_Interp *interp,		/* Interpreter containing variable. */
     const Var *varPtr,		/* Array variable search is for. */
@@ -4832,7 +5120,7 @@ ParseSearchId(
 				 * name. */
 {
     Interp *iPtr = (Interp *) interp;
-    ArraySearch *searchPtr;
+    Tcl_ArraySearch *searchPtr;
     const char *handle = TclGetString(handleObj);
     char *end;
 
@@ -4841,14 +5129,14 @@ ParseSearchId(
 		Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
 
 	/* First look for same (Tcl_Obj *) */
-	for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
+	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_GetHashValue(hPtr); searchPtr != NULL;
+	for (searchPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(hPtr); searchPtr != NULL;
 		searchPtr = searchPtr->nextPtr) {
 	    if (strcmp(TclGetString(searchPtr->name), handle) == 0) {
 		return searchPtr;
@@ -4895,12 +5183,12 @@ DeleteSearches(
     register Var *arrayVarPtr)	/* Variable whose searches are to be
 				 * deleted. */
 {
-    ArraySearch *searchPtr, *nextPtr;
+    Tcl_ArraySearch *searchPtr, *nextPtr;
     Tcl_HashEntry *sPtr;
 
     if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
 	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
-	for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
+	for (searchPtr = (Tcl_ArraySearch *) Tcl_GetHashValue(sPtr); searchPtr != NULL;
 		searchPtr = nextPtr) {
 	    nextPtr = searchPtr->nextPtr;
 	    Tcl_DecrRefCount(searchPtr->name);

tests/set-old.test

@@ -340,7 +340,7 @@ 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, get, names, nextelement, set, size, startsearch, statistics, or unset}}
+} {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

tests/var.test

@@ -22,6 +22,8 @@ if {"::tcltest" ni [namespace children]} {
 ::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]]
@@ -997,6 +999,120 @@ test var-22.2 {leak in parsedVarName} -constraints memory -body {
     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}
@@ -1011,6 +1127,7 @@ catch {unset x}
 catch {unset y}
 catch {unset i}
 catch {unset a}
+catch {unset reslist}
 catch {unset xxxxx}
 catch {unset aaaaa}