From dadccca81c83f99bae348c4caecf3a90270e7e6a Mon Sep 17 00:00:00 2001
From: twylite <twylite@crypt.co.za>
Date: Wed, 8 Aug 2012 15:34:13 +0000
Subject: Rename 'mapeach' to 'lmap' per preferred alternative in TIP #405.

---
 generic/tclBasic.c    |   2 +-
 generic/tclCmdAH.c    |   6 +-
 generic/tclCompCmds.c |  10 +-
 generic/tclInt.h      |  16 +-
 tests/lmap.test       | 493 ++++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 510 insertions(+), 17 deletions(-)
 create mode 100644 tests/lmap.test

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a35da29..36e777a 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -230,6 +230,7 @@ static const CmdInfo builtInCmds[] = {
     {"linsert",		Tcl_LinsertObjCmd,	NULL,			NULL,	1},
     {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	1},
     {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	1},
+    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	1},
     {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	1},
     {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	1},
     {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	1},
@@ -237,7 +238,6 @@ static const CmdInfo builtInCmds[] = {
     {"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},
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index a10646c..9ebdf21 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -2599,17 +2599,17 @@ TclNRForeachCmd(
 }
 
 int
-Tcl_MapeachObjCmd(
+Tcl_LmapObjCmd(
     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);
+    return Tcl_NRCallObjProc(interp, TclNRLmapCmd, dummy, objc, objv);
 }
 
 int
-TclNRMapeachCmd(
+TclNRLmapCmd(
     ClientData dummy,
     Tcl_Interp *interp,
     int objc,
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 395a0f8..4d015ec 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1943,7 +1943,7 @@ TclCompileForeachCmd(
  *
  * TclCompileEachloopCmd --
  *
- *	Procedure called to compile the "foreach" and "mapeach" commands.
+ *	Procedure called to compile the "foreach" and "lmap" commands.
  *
  * Results:
  *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
@@ -3832,23 +3832,23 @@ TclCompileLsetCmd(
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileMapeachCmd --
+ * TclCompileLmapCmd --
  *
- *	Procedure called to compile the "mapeach" command.
+ *	Procedure called to compile the "lmap" 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
+ *	Instructions are added to envPtr to execute the "lmap" command at
  *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileMapeachCmd(
+TclCompileLmapCmd(
     Tcl_Interp *interp,		/* Used for error reporting. */
     Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
 				 * created by Tcl_ParseCommand. */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4fc265f..f1a6fce 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2774,7 +2774,7 @@ 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 TclNRLmapCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd;
@@ -2862,7 +2862,7 @@ struct Tcl_LoadHandle_ {
 				/* Discard iteration result like [foreach] */
 
 #define TCL_EACH_COLLECT		1
-				/* Collect iteration result like [mapeach] */
+				/* Collect iteration result like [lmap] */
 
 
 /*
@@ -3353,6 +3353,9 @@ MODULE_SCOPE int	Tcl_LlengthObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tcl_ListObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_LmapObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	Tcl_LoadObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -3377,9 +3380,6 @@ MODULE_SCOPE int	Tcl_LsetObjCmd(ClientData clientData,
 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,
@@ -3569,6 +3569,9 @@ MODULE_SCOPE int	TclCompileListCmd(Tcl_Interp *interp,
 MODULE_SCOPE int	TclCompileLlengthCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileLmapCmd(Tcl_Interp *interp,
+			    Tcl_Parse *parsePtr, Command *cmdPtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileLrangeCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
@@ -3578,9 +3581,6 @@ MODULE_SCOPE int	TclCompileLreplaceCmd(Tcl_Interp *interp,
 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);
diff --git a/tests/lmap.test b/tests/lmap.test
new file mode 100644
index 0000000..dc5053f
--- /dev/null
+++ b/tests/lmap.test
@@ -0,0 +1,493 @@
+# Commands covered:  lmap, 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 "lmap" operation (non-compiled)
+
+test lmap-1.1 {basic lmap tests} {
+    set a {}
+    lmap i {a b c d} {
+	set a [concat $a $i]
+    }
+} {a {a b} {a b c} {a b c d}}
+test lmap-1.2 {basic lmap tests} {
+    lmap i {a b {{c d} e} {123 {{x}}}} {
+	set i
+    }
+} {a b {{c d} e} {123 {{x}}}}
+test lmap-1.2a {basic lmap tests} {
+    lmap i {a b {{c d} e} {123 {{x}}}} {
+  return -level 0 $i
+    }
+} {a b {{c d} e} {123 {{x}}}}
+test lmap-1.3 {basic lmap tests} {catch {lmap} msg} 1
+test lmap-1.4 {basic lmap tests} {
+    catch {lmap} msg
+    set msg
+} {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.5 {basic lmap tests} {catch {lmap i} msg} 1
+test lmap-1.6 {basic lmap tests} {
+    catch {lmap i} msg
+    set msg
+} {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.7 {basic lmap tests} {catch {lmap i j} msg} 1
+test lmap-1.8 {basic lmap tests} {
+    catch {lmap i j} msg
+    set msg
+} {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.9 {basic lmap tests} {catch {lmap i j k l} msg} 1
+test lmap-1.10 {basic lmap tests} {
+    catch {lmap i j k l} msg
+    set msg
+} {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.11 {basic lmap tests} {
+    lmap i {} {
+      set i
+    }
+} {}
+test lmap-1.12 {basic lmap tests} {
+    lmap i {} {
+      return -level 0 x
+    }
+} {}
+test lmap-1.13 {lmap errors} {
+    list [catch {lmap {{a}{b}} {1 2 3} {}} msg] $msg
+} {1 {list element in braces followed by "{b}" instead of space}}
+test lmap-1.14 {lmap errors} {
+    list [catch {lmap a {{1 2}3} {}} msg] $msg
+} {1 {list element in braces followed by "3" instead of space}}
+catch {unset a}
+test lmap-1.15 {lmap errors} {
+    catch {unset a}
+    set a(0) 44
+    list [catch {lmap 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
+"lmap a {1 2 3} {}"}}
+test lmap-1.16 {lmap errors} {
+    list [catch {lmap {} {} {}} msg] $msg
+} {1 {foreach varlist is empty}}
+catch {unset a}
+
+
+# Parallel "lmap" operation (non-compiled)
+
+test lmap-2.1 {parallel lmap tests} {
+    lmap {a b} {1 2 3 4} {
+	list $b $a
+    }
+} {{2 1} {4 3}}
+test lmap-2.2 {parallel lmap tests} {
+    lmap {a b} {1 2 3 4 5} {
+	list $b $a
+    }
+} {{2 1} {4 3} {{} 5}}
+test lmap-2.3 {parallel lmap tests} {
+    lmap a {1 2 3} b {4 5 6} {
+	list $b $a
+    }
+} {{4 1} {5 2} {6 3}}
+test lmap-2.4 {parallel lmap tests} {
+    lmap a {1 2 3} b {4 5 6 7 8} {
+	list $b $a
+    }
+} {{4 1} {5 2} {6 3} {7 {}} {8 {}}}
+test lmap-2.5 {parallel lmap tests} {
+    lmap {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 lmap-2.6 {parallel lmap tests} {
+    lmap 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 lmap-2.7 {parallel lmap tests} {
+    lmap 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 lmap-2.8 {parallel lmap tests} {
+    lmap 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 lmap-2.9 {lmap only sets vars if repeating loop} {
+  namespace eval ::lmap_test {
+    set rgb {65535 0 0}
+    lmap {r g b} [set rgb] {}
+    set ::x "r=$r, g=$g, b=$b"
+  }
+  namespace delete ::lmap_test
+  set x
+} {r=65535, g=0, b=0}
+test lmap-2.10 {lmap only supports local scalar variables} {
+  catch { unset a }
+  lmap {a(3)} {1 2 3 4} {set {a(3)}}
+} {1 2 3 4}
+catch { unset a }
+
+
+# "lmap" with "continue" and "break" (non-compiled)
+
+test lmap-3.1 {continue tests} {
+    lmap i {a b c d} {
+	if {[string compare $i "b"] == 0} continue
+	set i
+    }
+} {a c d}
+test lmap-3.2 {continue tests} {
+    set x 0
+    list [lmap i {a b c d} {
+    	incr x
+    	if {[string compare $i "b"] != 0} continue
+    	set i
+    }] $x
+} {b 4}
+test lmap-3.3 {break tests} {
+    set x 0
+    list [lmap 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 lmap-3.4 {break tests} {
+	set a 1
+	lmap b b {list [concat a; break]; incr a}
+	incr a
+} {2}
+
+
+# ----- Compiled operation ------------------------------------------------------
+
+# Basic "lmap" operation (compiled)
+
+test lmap-4.1 {basic lmap tests} {
+  apply {{} {
+    set a {}
+    lmap i {a b c d} {
+      set a [concat $a $i]
+    }
+  }}
+} {a {a b} {a b c} {a b c d}}
+test lmap-4.2 {basic lmap tests} {
+  apply {{} {
+    lmap i {a b {{c d} e} {123 {{x}}}} {
+      set i
+    }
+  }}
+} {a b {{c d} e} {123 {{x}}}}
+test lmap-4.2a {basic lmap tests} {
+  apply {{} {
+    lmap i {a b {{c d} e} {123 {{x}}}} {
+      return -level 0 $i
+    }
+  }}
+} {a b {{c d} e} {123 {{x}}}}
+test lmap-4.3 {basic lmap tests} {catch { apply {{} { lmap }} } msg} 1
+test lmap-4.4 {basic lmap tests} {
+    catch { apply {{} { lmap }} } msg
+    set msg
+} {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.5 {basic lmap tests} {catch { apply {{} { lmap i }} } msg} 1
+test lmap-4.6 {basic lmap tests} {
+    catch { apply {{} { lmap i }} } msg
+    set msg
+} {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.7 {basic lmap tests} {catch { apply {{} { lmap i j }} } msg} 1
+test lmap-4.8 {basic lmap tests} {
+    catch { apply {{} { lmap i j }} } msg
+    set msg
+} {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.9 {basic lmap tests} {catch { apply {{} { lmap i j k l }} } msg} 1
+test lmap-4.10 {basic lmap tests} {
+    catch { apply {{} { lmap i j k l }} } msg
+    set msg
+} {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.11 {basic lmap tests} {
+  apply {{} { lmap i {} { set i } }}
+} {}
+test lmap-4.12 {basic lmap tests} {
+  apply {{} { lmap i {} { return -level 0 x } }}
+} {}
+test lmap-4.13 {lmap errors} {
+    list [catch { apply {{} { lmap {{a}{b}} {1 2 3} {} }} } msg] $msg
+} {1 {list element in braces followed by "{b}" instead of space}}
+test lmap-4.14 {lmap errors} {
+    list [catch { apply {{} { lmap a {{1 2}3} {} }} } msg] $msg
+} {1 {list element in braces followed by "3" instead of space}}
+catch {unset a}
+test lmap-4.15 {lmap errors} {
+    apply {{} { 
+      set a(0) 44
+      list [catch {lmap 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
+"lmap a {1 2 3} {}"}}
+test lmap-4.16 {lmap errors} {
+    list [catch { apply {{} { lmap {} {} {} }} } msg] $msg
+} {1 {foreach varlist is empty}}
+catch {unset a}
+
+
+# Parallel "lmap" operation (compiled)
+
+test lmap-5.1 {parallel lmap tests} {
+  apply {{} {
+    lmap {a b} {1 2 3 4} {
+      list $b $a
+    }
+  }}
+} {{2 1} {4 3}}
+test lmap-5.2 {parallel lmap tests} {
+  apply {{} {
+    lmap {a b} {1 2 3 4 5} {
+      list $b $a
+    }
+  }}
+} {{2 1} {4 3} {{} 5}}
+test lmap-5.3 {parallel lmap tests} {
+  apply {{} {
+    lmap a {1 2 3} b {4 5 6} {
+      list $b $a
+    }
+  }}
+} {{4 1} {5 2} {6 3}}
+test lmap-5.4 {parallel lmap tests} {
+  apply {{} {
+    lmap a {1 2 3} b {4 5 6 7 8} {
+	list $b $a
+    }
+  }}
+} {{4 1} {5 2} {6 3} {7 {}} {8 {}}}
+test lmap-5.5 {parallel lmap tests} {
+  apply {{} {
+    lmap {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 lmap-5.6 {parallel lmap tests} {
+  apply {{} {
+    lmap 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 lmap-5.7 {parallel lmap tests} {
+  apply {{} {
+    lmap 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 lmap-5.8 {parallel lmap tests} {
+  apply {{} {
+    lmap 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 lmap-5.9 {lmap only sets vars if repeating loop} {
+    apply {{} {
+        set rgb {65535 0 0}
+        lmap {r g b} [set rgb] {}
+        return "r=$r, g=$g, b=$b"
+    }}
+} {r=65535, g=0, b=0}
+test lmap-5.10 {lmap only supports local scalar variables} {
+    apply {{} {
+        lmap {a(3)} {1 2 3 4} {set {a(3)}}
+    }}
+} {1 2 3 4}
+
+
+# "lmap" with "continue" and "break" (compiled)
+
+test lmap-6.1 {continue tests} {
+  apply {{} {
+    lmap i {a b c d} {
+      if {[string compare $i "b"] == 0} continue
+      set i
+    }
+  }}
+} {a c d}
+test lmap-6.2 {continue tests} {
+  apply {{} {
+    list [lmap i {a b c d} {
+      incr x
+    	if {[string compare $i "b"] != 0} continue
+    	set i
+    }] $x
+  }}
+} {b 4}
+test lmap-6.3 {break tests} {
+  apply {{} {
+    list [lmap 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 lmap-6.4 {break tests} {
+    apply {{} {
+	set a 1
+	lmap b b {list [concat a; break]; incr a}
+	incr a
+    }}
+} {2}
+
+
+
+# ----- Special cases and bugs -------------------------------------------------
+
+
+test lmap-7.1 {compiled lmap 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
+        lmap member [array names a] {
+            list $member [set a($member)]
+        }
+    }} x]
+} [lsort {{0 zero} {1 one} {2 two} {3 three}}]
+
+test lmap-7.2 {noncompiled lmap and shared variable or value list objects that are converted to another type} {
+    catch {unset x}
+    lmap {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 lmap-7.3 {delayed substitution of body} {
+    apply {{} {
+       set a 0
+       lmap a [list 1 2 3] "
+           set x $a
+       "
+       set x
+    }}
+} {0}
+
+# Related to "foreach" test for [Bug 1189274]; crash on failure
+test lmap-7.4 {empty list handling} {
+    proc crash {} {
+	rename crash {}
+	set a "x y z"
+	set b ""
+	lmap 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 lmap-7.5 {compiled empty var list} {
+    proc foo {} {
+	lmap {} x {
+	    error "reached body"
+	}
+    }
+    list [catch { foo } msg] $msg
+} {1 {foreach varlist is empty}}
+
+test lmap-7.6 {lmap: related to "foreach" [Bug 1671087]} -setup {
+    proc demo {} {
+	set vals {1 2 3 4}
+	trace add variable x write {string length $vals ;# }
+	lmap {x y} $vals {format $y}
+    }
+} -body {
+    demo
+} -cleanup {
+    rename demo {}
+} -result {2 4}
+
+# Huge lists must not overflow the bytecode interpreter (development bug)
+test lmap-7.7 {huge list non-compiled} {
+  set x [lmap a [lrepeat 1000000 x] { set b y$a }]
+  list $b [llength $x] [string length $x]
+} {yx 1000000 2999999}
+
+test lmap-7.8 {huge list compiled} {
+  set x [apply {{times} { lmap a [lrepeat $times x] { set b y$a }}} 1000000]
+  list $b [llength $x] [string length $x]
+} {yx 1000000 2999999}
+
+test lmap-7.9 {error then dereference loop var (dev bug)} {
+  catch { lmap a 0 b {1 2 3} { error x } }
+  set a
+} 0
+test lmap-7.9a {error then dereference loop var (dev bug)} {
+  catch { lmap a 0 b {1 2 3} { incr a $b; error x } }
+  set a
+} 1
+
+# ----- Coroutines -------------------------------------------------------------
+
+test lmap-8.1 {lmap non-compiled with coroutines} {
+  coroutine coro apply {{} {
+    set values [yield [info coroutine]]
+    eval lmap 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 lmap-8.2 {lmap compiled with coroutines} {
+  coroutine coro apply {{} {
+    set values [yield [info coroutine]]
+    lmap 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
-- 
cgit v0.12