Index: generic/tclBasic.c
==================================================================
--- generic/tclBasic.c
+++ generic/tclBasic.c
@@ -235,10 +235,11 @@
     {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	1},
     {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	1},
     {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	1},
     {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	1},
     {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	1},
+    {"mapeach",		Tcl_MapeachObjCmd,	TclCompileMapeachCmd,	TclNRMapeachCmd,	1},
     {"package",		Tcl_PackageObjCmd,	NULL,			NULL,	1},
     {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	1},
     {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	1},
     {"regsub",		Tcl_RegsubObjCmd,	NULL,			NULL,	1},
     {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	1},
@@ -8847,11 +8848,11 @@
     TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN);
     iPtr->execEnvPtr = savedEEPtr;
 
     return TCL_OK;
 }
-
+
 int
 TclNRInterpCoroutine(
     ClientData clientData,
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */

Index: generic/tclCmdAH.c
==================================================================
--- generic/tclCmdAH.c
+++ generic/tclCmdAH.c
@@ -30,10 +30,11 @@
     Tcl_Obj ***varvList;	/* Array of var name lists. */
     Tcl_Obj **vCopyList;	/* Copies of var name list arguments. */
     int *argcList;		/* Array of value list sizes. */
     Tcl_Obj ***argvList;	/* Array of value lists. */
     Tcl_Obj **aCopyList;	/* Copies of value list arguments. */
+    Tcl_Obj *resultList;	/* List of result values from the loop body. */
 };
 
 /*
  * Prototypes for local procedures defined in this file:
  */
@@ -50,10 +51,12 @@
 static int		GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 			    Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr);
 static const char *	GetTypeFromMode(int mode);
 static int		StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
 			    Tcl_StatBuf *statPtr);
+static int		TclNREachloopCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[], int collect);
 static Tcl_NRPostProc	CatchObjCmdCallback;
 static Tcl_NRPostProc	ExprCallback;
 static Tcl_NRPostProc	ForSetupCallback;
 static Tcl_NRPostProc	ForCondCallback;
 static Tcl_NRPostProc	ForNextCallback;
@@ -2558,11 +2561,11 @@
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ForeachObjCmd, TclNRForeachCmd --
+ * Tcl_ForeachObjCmd, TclNRForeachCmd, TclNREachloopCmd --
  *
  *	This object-based procedure is invoked to process the "foreach" Tcl
  *	command. See the user documentation for details on what it does.
  *
  * Results:
@@ -2590,10 +2593,42 @@
     ClientData dummy,
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const objv[])
 {
+    return TclNREachloopCmd(dummy, interp, objc, objv, 0);
+}
+
+int
+Tcl_MapeachObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    return Tcl_NRCallObjProc(interp, TclNRMapeachCmd, dummy, objc, objv);
+}
+
+int
+TclNRMapeachCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    return TclNREachloopCmd(dummy, interp, objc, objv, 1);
+}
+
+int
+TclNREachloopCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[],
+    int collect)		/* Flag == 1 to collect and return loop body result. */
+{
+
     int numLists = (objc-2) / 2;
     register struct ForeachState *statePtr;
     int i, j, result;
 
     if (objc < 4 || (objc%2 != 0)) {
@@ -2632,10 +2667,12 @@
     statePtr->argcList = statePtr->varcList + numLists;
 
     statePtr->numLists = numLists;
     statePtr->bodyPtr = objv[objc - 1];
     statePtr->bodyIdx = objc - 1;
+
+    statePtr->resultList = Tcl_NewListObj(0, NULL);
 
     /*
      * Break up the value lists and variable lists into elements.
      */
 
@@ -2681,11 +2718,11 @@
 	result = ForeachAssignments(interp, statePtr);
 	if (result == TCL_ERROR) {
 	    goto done;
 	}
 
-	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
+	TclNRAddCallback(interp, ForeachLoopStep, statePtr, collect, NULL, NULL);
 	return TclNREvalObjEx(interp, objv[objc-1], 0,
 		((Interp *) interp)->cmdFramePtr, objc-1);
     }
 
     /*
@@ -2708,24 +2745,29 @@
     ClientData data[],
     Tcl_Interp *interp,
     int result)
 {
     register struct ForeachState *statePtr = data[0];
+    int collect = (int)data[1];
 
     /*
      * Process the result code from this run of the [foreach] body. Note that
      * this switch uses fallthroughs in several places. Maintainer aware!
      */
 
     switch (result) {
     case TCL_CONTINUE:
 	result = TCL_OK;
+	break;
     case TCL_OK:
+	if (collect == 1) {
+	  Tcl_ListObjAppendElement(interp, statePtr->resultList, Tcl_GetObjResult(interp));
+	}
 	break;
     case TCL_BREAK:
 	result = TCL_OK;
-	goto done;
+	goto finish;
     case TCL_ERROR:
 	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 		"\n    (\"foreach\" body line %d)", Tcl_GetErrorLine(interp)));
     default:
 	goto done;
@@ -2740,20 +2782,21 @@
 	result = ForeachAssignments(interp, statePtr);
 	if (result == TCL_ERROR) {
 	    goto done;
 	}
 
-	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
+	TclNRAddCallback(interp, ForeachLoopStep, statePtr, collect, NULL, NULL);
 	return TclNREvalObjEx(interp, statePtr->bodyPtr, 0,
 		((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx);
     }
 
     /*
      * We're done. Tidy up our work space and finish off.
      */
-
-    Tcl_ResetResult(interp);
+  finish:
+    Tcl_SetObjResult(interp, statePtr->resultList);
+    statePtr->resultList = NULL; /* Don't clean it up */
   done:
     ForeachCleanup(interp, statePtr);
     return result;
 }
 
@@ -2810,10 +2853,13 @@
 	    TclDecrRefCount(statePtr->vCopyList[i]);
 	}
 	if (statePtr->aCopyList[i]) {
 	    TclDecrRefCount(statePtr->aCopyList[i]);
 	}
+	if (statePtr->resultList) {
+	    TclDecrRefCount(statePtr->resultList);
+	}
     }
     TclStackFree(interp, statePtr);
 }
 
 /*

Index: generic/tclCompCmds.c
==================================================================
--- generic/tclCompCmds.c
+++ generic/tclCompCmds.c
@@ -38,10 +38,14 @@
 static int		PushVarName(Tcl_Interp *interp,
 			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
 			    int flags, int *localIndexPtr,
 			    int *simpleVarNamePtr, int *isScalarPtr,
 			    int line, int *clNext);
+static int		TclCompileEachloopCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,	 CompileEnv *envPtr,
+			    int collect);
+
 
 /*
  * Macro that encapsulates an efficiency trick that avoids a function call for
  * the simplest of compiles. The ANSI C "prototype" for this macro is:
  *
@@ -1868,18 +1872,51 @@
 				 * created by Tcl_ParseCommand. */
     Command *cmdPtr,		/* Points to defintion of command being
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
+  return TclCompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileEachloopCmd --
+ *
+ *	Procedure called to compile the "foreach" and "mapeach" commands.
+ *
+ * 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 "foreach" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TclCompileEachloopCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    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. */
+    int collect)		/* Flag == 1 to collect and return loop body result. */
+{
     Proc *procPtr = envPtr->procPtr;
     ForeachInfo *infoPtr;	/* Points to the structure describing this
 				 * foreach command. Stored in a AuxData
 				 * record in the ByteCode. */
     int firstValueTemp;		/* Index of the first temp var in the frame
 				 * used to point to a value list. */
     int loopCtTemp;		/* Index of temp var holding the loop's
 				 * iteration count. */
+    int collectTemp; /* Index of temp var holding the result list. */
+
     Tcl_Token *tokenPtr, *bodyTokenPtr;
     unsigned char *jumpPc;
     JumpFixup jumpFalseFixup;
     int jumpBackDist, jumpBackOffset, infoIndex, range, bodyIndex;
     int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
@@ -2065,10 +2102,26 @@
 	    Emit14Inst(		INST_STORE_SCALAR, tempVar,	envPtr);
 	    TclEmitOpcode(	INST_POP,			envPtr);
 	    loopIndex++;
 	}
     }
+
+    /*
+     * Create temporary variable to capture return values from loop body.
+     */
+     
+    if (collect == 1) {
+	    collectTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, envPtr);
+	    
+	    PushLiteral(envPtr, "", 0);
+	    if (collectTemp <= 255) {
+	      TclEmitInstInt1(  INST_STORE_SCALAR1, collectTemp, envPtr);
+	    } else {
+	      TclEmitInstInt4(  INST_STORE_SCALAR4, collectTemp, envPtr);
+	    }
+	    TclEmitOpcode(      INST_POP,       envPtr);
+    }
 
     /*
      * Initialize the temporary var that holds the count of loop iterations.
      */
 
@@ -2090,11 +2143,20 @@
     SetLineInformation(bodyIndex);
     ExceptionRangeStarts(envPtr, range);
     CompileBody(envPtr, bodyTokenPtr, interp);
     ExceptionRangeEnds(envPtr, range);
     envPtr->currStackDepth = savedStackDepth + 1;
-    TclEmitOpcode(		INST_POP,			envPtr);
+
+    if (collect == 1) {
+	    if (collectTemp <= 255) {
+	      TclEmitInstInt1(  INST_LAPPEND_SCALAR1, collectTemp, envPtr);
+	    } else {
+	      TclEmitInstInt4(  INST_LAPPEND_SCALAR4, collectTemp, envPtr);
+	    }
+    }
+    TclEmitOpcode(        INST_POP,           envPtr);
+
 
     /*
      * Jump back to the test at the top of the loop. Generate a 4 byte jump if
      * the distance to the test is > 120 bytes. This is conservative and
      * ensures that we won't have to replace this jump if we later need to
@@ -2140,15 +2202,24 @@
      */
 
     ExceptionRangeTarget(envPtr, range, breakOffset);
 
     /*
-     * The foreach command's result is an empty string.
+     * The command's result is an empty string if not collecting, or the
+     * list of results from evaluating the loop body.
      */
 
     envPtr->currStackDepth = savedStackDepth;
-    PushLiteral(envPtr, "", 0);
+    if (collect == 1) {
+	    if (collectTemp <= 255) {
+	      TclEmitInstInt1(  INST_LOAD_SCALAR1, collectTemp, envPtr);
+	    } else {
+	      TclEmitInstInt4(  INST_LOAD_SCALAR4, collectTemp, envPtr);
+	    }
+    } else {
+	    PushLiteral(envPtr, "", 0);
+    }
     envPtr->currStackDepth = savedStackDepth + 1;
 
   done:
     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
 	if (varvList[loopIndex] != NULL) {
@@ -3694,10 +3765,40 @@
 	}
     }
 
     return TCL_OK;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileMapeachCmd --
+ *
+ *	Procedure called to compile the "mapeach" 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 "mapeach" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileMapeachCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    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 TclCompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, 1);
+}
 
 /*
  *----------------------------------------------------------------------
  *
  * TclCompileNamespaceCmd --

Index: generic/tclInt.h
==================================================================
--- generic/tclInt.h
+++ generic/tclInt.h
@@ -2772,10 +2772,11 @@
 MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRMapeachCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd;
@@ -3363,10 +3364,13 @@
 MODULE_SCOPE int	Tcl_LsetObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	Tcl_LsortObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_MapeachObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp);
 MODULE_SCOPE int	TclNamespaceEnsembleCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -3558,10 +3562,13 @@
 MODULE_SCOPE int	TclCompileLreplaceCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileLsetCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileMapeachCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileNamespaceUpvarCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileNoOp(Tcl_Interp *interp,

ADDED    tests/mapeach.test
Index: tests/mapeach.test
==================================================================
--- tests/mapeach.test
+++ tests/mapeach.test
@@ -0,0 +1,485 @@
+# Commands covered:  mapeach, continue, break
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 2011 Trevor Davel
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+catch {unset a}
+catch {unset i}
+catch {unset x}
+
+# ----- Non-compiled operation -------------------------------------------------
+
+
+# Basic "mapeach" operation (non-compiled)
+
+test mapeach-1.1 {basic mapeach tests} {
+    set a {}
+    mapeach i {a b c d} {
+	set a [concat $a $i]
+    }
+} {a {a b} {a b c} {a b c d}}
+test mapeach-1.2 {basic mapeach tests} {
+    mapeach i {a b {{c d} e} {123 {{x}}}} {
+	set i
+    }
+} {a b {{c d} e} {123 {{x}}}}
+test mapeach-1.2a {basic mapeach tests} {
+    mapeach i {a b {{c d} e} {123 {{x}}}} {
+  return -level 0 $i
+    }
+} {a b {{c d} e} {123 {{x}}}}
+test mapeach-1.3 {basic mapeach tests} {catch {mapeach} msg} 1
+test mapeach-1.4 {basic mapeach tests} {
+    catch {mapeach} msg
+    set msg
+} {wrong # args: should be "mapeach varList list ?varList list ...? command"}
+test mapeach-1.5 {basic mapeach tests} {catch {mapeach i} msg} 1
+test mapeach-1.6 {basic mapeach tests} {
+    catch {mapeach i} msg
+    set msg
+} {wrong # args: should be "mapeach varList list ?varList list ...? command"}
+test mapeach-1.7 {basic mapeach tests} {catch {mapeach i j} msg} 1
+test mapeach-1.8 {basic mapeach tests} {
+    catch {mapeach i j} msg
+    set msg
+} {wrong # args: should be "mapeach varList list ?varList list ...? command"}
+test mapeach-1.9 {basic mapeach tests} {catch {mapeach i j k l} msg} 1
+test mapeach-1.10 {basic mapeach tests} {
+    catch {mapeach i j k l} msg
+    set msg
+} {wrong # args: should be "mapeach varList list ?varList list ...? command"}
+test mapeach-1.11 {basic mapeach tests} {
+    mapeach i {} {
+      set i
+    }
+} {}
+test mapeach-1.12 {basic mapeach tests} {
+    mapeach i {} {
+      return -level 0 x
+    }
+} {}
+test mapeach-1.13 {mapeach errors} {
+    list [catch {mapeach {{a}{b}} {1 2 3} {}} msg] $msg
+} {1 {list element in braces followed by "{b}" instead of space}}
+test mapeach-1.14 {mapeach errors} {
+    list [catch {mapeach a {{1 2}3} {}} msg] $msg
+} {1 {list element in braces followed by "3" instead of space}}
+catch {unset a}
+test mapeach-1.15 {mapeach errors} {
+    catch {unset a}
+    set a(0) 44
+    list [catch {mapeach a {1 2 3} {}} msg o] $msg $::errorInfo
+} {1 {can't set "a": variable is array} {can't set "a": variable is array
+    (setting foreach loop variable "a")
+    invoked from within
+"mapeach a {1 2 3} {}"}}
+test mapeach-1.16 {mapeach errors} {
+    list [catch {mapeach {} {} {}} msg] $msg
+} {1 {foreach varlist is empty}}
+catch {unset a}
+
+
+# Parallel "mapeach" operation (non-compiled)
+
+test mapeach-2.1 {parallel mapeach tests} {
+    mapeach {a b} {1 2 3 4} {
+	list $b $a
+    }
+} {{2 1} {4 3}}
+test mapeach-2.2 {parallel mapeach tests} {
+    mapeach {a b} {1 2 3 4 5} {
+	list $b $a
+    }
+} {{2 1} {4 3} {{} 5}}
+test mapeach-2.3 {parallel mapeach tests} {
+    mapeach a {1 2 3} b {4 5 6} {
+	list $b $a
+    }
+} {{4 1} {5 2} {6 3}}
+test mapeach-2.4 {parallel mapeach tests} {
+    mapeach a {1 2 3} b {4 5 6 7 8} {
+	list $b $a
+    }
+} {{4 1} {5 2} {6 3} {7 {}} {8 {}}}
+test mapeach-2.5 {parallel mapeach tests} {
+    mapeach {a b} {a b A B aa bb} c {c C cc CC} {
+	list $a $b $c
+    }
+} {{a b c} {A B C} {aa bb cc} {{} {} CC}}
+test mapeach-2.6 {parallel mapeach tests} {
+    mapeach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
+	list $a$b$c$d$e
+    }
+} {11111 22222 33333}
+test mapeach-2.7 {parallel mapeach tests} {
+    mapeach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+	set x $a$b$c$d$e
+    }
+} {{1111 2} 222 33 4}
+test mapeach-2.8 {parallel mapeach tests} {
+    mapeach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+	join [list $a $b $c $d $e] .
+    }
+} {{.1.1.1.1 2} .2.2.2. .3..3. ...4.}
+test mapeach-2.9 {mapeach only sets vars if repeating loop} {
+  namespace eval ::mapeach_test {
+    set rgb {65535 0 0}
+    mapeach {r g b} [set rgb] {}
+    set ::x "r=$r, g=$g, b=$b"
+  }
+  namespace delete ::mapeach_test
+  set x
+} {r=65535, g=0, b=0}
+test mapeach-2.10 {mapeach only supports local scalar variables} {
+  catch { unset a }
+  mapeach {a(3)} {1 2 3 4} {set {a(3)}}
+} {1 2 3 4}
+catch { unset a }
+
+
+# "mapeach" with "continue" and "break" (non-compiled)
+
+test mapeach-3.1 {continue tests} {
+    mapeach i {a b c d} {
+	if {[string compare $i "b"] == 0} continue
+	set i
+    }
+} {a c d}
+test mapeach-3.2 {continue tests} {
+    set x 0
+    list [mapeach i {a b c d} {
+    	incr x
+    	if {[string compare $i "b"] != 0} continue
+    	set i
+    }] $x
+} {b 4}
+test mapeach-3.3 {break tests} {
+    set x 0
+    list [mapeach i {a b c d} {
+      incr x
+    	if {[string compare $i "c"] == 0} break
+    	set i
+    }] $x
+} {{a b} 3}
+# Check for bug similar to #406709
+test mapeach-3.4 {break tests} {
+	set a 1
+	mapeach b b {list [concat a; break]; incr a}
+	incr a
+} {2}
+
+
+# ----- Compiled operation ------------------------------------------------------
+
+# Basic "mapeach" operation (compiled)
+
+test mapeach-4.1 {basic mapeach tests} {
+  apply {{} {
+    set a {}
+    mapeach i {a b c d} {
+      set a [concat $a $i]
+    }
+  }}
+} {a {a b} {a b c} {a b c d}}
+test mapeach-4.2 {basic mapeach tests} {
+  apply {{} {
+    mapeach i {a b {{c d} e} {123 {{x}}}} {
+      set i
+    }
+  }}
+} {a b {{c d} e} {123 {{x}}}}
+test mapeach-4.2a {basic mapeach tests} {
+  apply {{} {
+    mapeach i {a b {{c d} e} {123 {{x}}}} {
+      return -level 0 $i
+    }
+  }}
+} {a b {{c d} e} {123 {{x}}}}
+test mapeach-4.3 {basic mapeach tests} {catch { apply {{} { mapeach }} } msg} 1
+test mapeach-4.4 {basic mapeach tests} {
+    catch { apply {{} { mapeach }} } msg
+    set msg
+} {wrong # args: should be "mapeach varList list ?varList list ...? command"}
+test mapeach-4.5 {basic mapeach tests} {catch { apply {{} { mapeach i }} } msg} 1
+test mapeach-4.6 {basic mapeach tests} {
+    catch { apply {{} { mapeach i }} } msg
+    set msg
+} {wrong # args: should be "mapeach varList list ?varList list ...? command"}
+test mapeach-4.7 {basic mapeach tests} {catch { apply {{} { mapeach i j }} } msg} 1
+test mapeach-4.8 {basic mapeach tests} {
+    catch { apply {{} { mapeach i j }} } msg
+    set msg
+} {wrong # args: should be "mapeach varList list ?varList list ...? command"}
+test mapeach-4.9 {basic mapeach tests} {catch { apply {{} { mapeach i j k l }} } msg} 1
+test mapeach-4.10 {basic mapeach tests} {
+    catch { apply {{} { mapeach i j k l }} } msg
+    set msg
+} {wrong # args: should be "mapeach varList list ?varList list ...? command"}
+test mapeach-4.11 {basic mapeach tests} {
+  apply {{} { mapeach i {} { set i } }}
+} {}
+test mapeach-4.12 {basic mapeach tests} {
+  apply {{} { mapeach i {} { return -level 0 x } }}
+} {}
+test mapeach-4.13 {mapeach errors} {
+    list [catch { apply {{} { mapeach {{a}{b}} {1 2 3} {} }} } msg] $msg
+} {1 {list element in braces followed by "{b}" instead of space}}
+test mapeach-4.14 {mapeach errors} {
+    list [catch { apply {{} { mapeach a {{1 2}3} {} }} } msg] $msg
+} {1 {list element in braces followed by "3" instead of space}}
+catch {unset a}
+test mapeach-4.15 {mapeach errors} {
+    apply {{} { 
+      set a(0) 44
+      list [catch {mapeach a {1 2 3} {}} msg o] $msg $::errorInfo 
+    }} 
+} {1 {can't set "a": variable is array} {can't set "a": variable is array
+    while executing
+"mapeach a {1 2 3} {}"}}
+test mapeach-4.16 {mapeach errors} {
+    list [catch { apply {{} { mapeach {} {} {} }} } msg] $msg
+} {1 {foreach varlist is empty}}
+catch {unset a}
+
+
+# Parallel "mapeach" operation (compiled)
+
+test mapeach-5.1 {parallel mapeach tests} {
+  apply {{} {
+    mapeach {a b} {1 2 3 4} {
+      list $b $a
+    }
+  }}
+} {{2 1} {4 3}}
+test mapeach-5.2 {parallel mapeach tests} {
+  apply {{} {
+    mapeach {a b} {1 2 3 4 5} {
+      list $b $a
+    }
+  }}
+} {{2 1} {4 3} {{} 5}}
+test mapeach-5.3 {parallel mapeach tests} {
+  apply {{} {
+    mapeach a {1 2 3} b {4 5 6} {
+      list $b $a
+    }
+  }}
+} {{4 1} {5 2} {6 3}}
+test mapeach-5.4 {parallel mapeach tests} {
+  apply {{} {
+    mapeach a {1 2 3} b {4 5 6 7 8} {
+	list $b $a
+    }
+  }}
+} {{4 1} {5 2} {6 3} {7 {}} {8 {}}}
+test mapeach-5.5 {parallel mapeach tests} {
+  apply {{} {
+    mapeach {a b} {a b A B aa bb} c {c C cc CC} {
+      list $a $b $c
+    }
+  }}
+} {{a b c} {A B C} {aa bb cc} {{} {} CC}}
+test mapeach-5.6 {parallel mapeach tests} {
+  apply {{} {
+    mapeach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
+      list $a$b$c$d$e
+    }
+  }}
+} {11111 22222 33333}
+test mapeach-5.7 {parallel mapeach tests} {
+  apply {{} {
+    mapeach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+      set x $a$b$c$d$e
+    }
+  }}
+} {{1111 2} 222 33 4}
+test mapeach-5.8 {parallel mapeach tests} {
+  apply {{} {
+    mapeach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+      join [list $a $b $c $d $e] .
+    }
+  }}
+} {{.1.1.1.1 2} .2.2.2. .3..3. ...4.}
+test mapeach-5.9 {mapeach only sets vars if repeating loop} {
+    apply {{} {
+        set rgb {65535 0 0}
+        mapeach {r g b} [set rgb] {}
+        return "r=$r, g=$g, b=$b"
+    }}
+} {r=65535, g=0, b=0}
+test mapeach-5.10 {mapeach only supports local scalar variables} {
+    apply {{} {
+        mapeach {a(3)} {1 2 3 4} {set {a(3)}}
+    }}
+} {1 2 3 4}
+
+
+# "mapeach" with "continue" and "break" (compiled)
+
+test mapeach-6.1 {continue tests} {
+  apply {{} {
+    mapeach i {a b c d} {
+      if {[string compare $i "b"] == 0} continue
+      set i
+    }
+  }}
+} {a c d}
+test mapeach-6.2 {continue tests} {
+  apply {{} {
+    list [mapeach i {a b c d} {
+      incr x
+    	if {[string compare $i "b"] != 0} continue
+    	set i
+    }] $x
+  }}
+} {b 4}
+test mapeach-6.3 {break tests} {
+  apply {{} {
+    list [mapeach i {a b c d} {
+      incr x
+    	if {[string compare $i "c"] == 0} break
+    	set i
+    }] $x
+  }}
+} {{a b} 3}
+# Check for bug similar to #406709
+test mapeach-6.4 {break tests} {
+    apply {{} {
+	set a 1
+	mapeach b b {list [concat a; break]; incr a}
+	incr a
+    }}
+} {2}
+
+
+
+# ----- Special cases and bugs -------------------------------------------------
+
+
+test mapeach-7.1 {compiled mapeach backward jump works correctly} {
+    catch {unset x}
+    array set x {0 zero 1 one 2 two 3 three}
+    lsort [apply {{arrayName} {
+        upvar 1 $arrayName a
+        mapeach member [array names a] {
+            list $member [set a($member)]
+        }
+    }} x]
+} [lsort {{0 zero} {1 one} {2 two} {3 three}}]
+
+test mapeach-7.2 {noncompiled mapeach and shared variable or value list objects that are converted to another type} {
+    catch {unset x}
+    mapeach {12.0} {a b c} {
+        set x 12.0
+        set x [expr $x + 1]
+    }
+} {13.0 13.0 13.0}
+
+# Test for incorrect "double evaluation" semantics
+test mapeach-7.3 {delayed substitution of body} {
+    apply {{} {
+       set a 0
+       mapeach a [list 1 2 3] "
+           set x $a
+       "
+       set x
+    }}
+} {0}
+
+# Related to "foreach" test for [Bug 1189274]; crash on failure
+test mapeach-7.4 {empty list handling} {
+    proc crash {} {
+	rename crash {}
+	set a "x y z"
+	set b ""
+	mapeach aa $a bb $b { set x "aa = $aa bb = $bb" }
+    }
+    crash
+} {{aa = x bb = } {aa = y bb = } {aa = z bb = }}
+
+# Related to [Bug 1671138]; infinite loop with empty var list in bytecompiled version
+test mapeach-7.5 {compiled empty var list} {
+    proc foo {} {
+	mapeach {} x {
+	    error "reached body"
+	}
+    }
+    list [catch { foo } msg] $msg
+} {1 {foreach varlist is empty}}
+
+test mapeach-7.6 {mapeach: related to "foreach" [Bug 1671087]} -setup {
+    proc demo {} {
+	set vals {1 2 3 4}
+	trace add variable x write {string length $vals ;# }
+	mapeach {x y} $vals {format $y}
+    }
+} -body {
+    demo
+} -cleanup {
+    rename demo {}
+} -result {2 4}
+
+# Huge lists must not overflow the bytecode interpreter (development bug)
+test mapeach-7.7 {huge list non-compiled} {
+  set x [mapeach a [lrepeat 1000000 x] { set b y$a }]
+  list $b [llength $x] [string length $x]
+} {yx 1000000 2999999}
+
+test mapeach-7.8 {huge list compiled} {
+  set x [apply {{times} { mapeach a [lrepeat $times x] { set b y$a }}} 1000000]
+  list $b [llength $x] [string length $x]
+} {yx 1000000 2999999}
+
+
+# ----- Coroutines -------------------------------------------------------------
+
+test mapeach-8.1 {mapeach non-compiled with coroutines} {
+  coroutine coro apply {{} {
+    set values [yield [info coroutine]]
+    eval mapeach i [list $values] {{ yield $i }}
+  }} ;# returns 'coro'
+  coro {a b c d e f} ;# -> a
+  coro 1 ;# -> b
+  coro 2 ;# -> c
+  coro 3 ;# -> d
+  coro 4 ;# -> e
+  coro 5 ;# -> f
+  list [coro 6] [info commands coro]
+} {{1 2 3 4 5 6} {}}
+
+test mapeach-8.2 {mapeach compiled with coroutines} {
+  coroutine coro apply {{} {
+    set values [yield [info coroutine]]
+    mapeach i $values { yield $i }
+  }} ;# returns 'coro'
+  coro {a b c d e f} ;# -> a
+  coro 1 ;# -> b
+  coro 2 ;# -> c
+  coro 3 ;# -> d
+  coro 4 ;# -> e
+  coro 5 ;# -> f
+  list [coro 6] [info commands coro]
+} {{1 2 3 4 5 6} {}}
+
+
+# cleanup
+catch {unset a}
+catch {unset x}
+catch {rename foo {}}
+::tcltest::cleanupTests
+return

