[Patch-3163961] Implementation of TIP #405 merged from private branch. Includes 'mapeach', 'dict map' and 'foreacha' commands, test suite (partial for 'foreacha') and man pages (except for 'foreacha').

4 files changed, 965 insertions, 0 deletions

diff --git a/tests/dict.test b/tests/dict.test
index 77bacf6..398493a 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -1521,6 +1521,252 @@ j
     }} [linenumber]}}
 } 5
 rename linenumber {}
+
+test dict-24.1 {dict map command: syntax} -returnCodes error -body {
+    dict map
+} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+test dict-24.2 {dict map command: syntax} -returnCodes error -body {
+    dict map x
+} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+test dict-24.3 {dict map command: syntax} -returnCodes error -body {
+    dict map x x
+} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+test dict-24.4 {dict map command: syntax} -returnCodes error -body {
+    dict map x x x x
+} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+test dict-24.5 {dict map command: syntax} -returnCodes error -body {
+    dict map x x x
+} -result {must have exactly two variable names}
+test dict-24.6 {dict map command: syntax} -returnCodes error -body {
+    dict map {x x x} x x
+} -result {must have exactly two variable names}
+test dict-24.7 {dict map command: syntax} -returnCodes error -body {
+    dict map "\{x" x x
+} -result {unmatched open brace in list}
+test dict-24.8 {dict map command} -body {
+    # This test confirms that [dict keys], [dict values] and [dict map]
+    # all traverse a dictionary in the same order.
+    set dictv {a A b B c C}
+    set values {}
+    set keys [dict map {k v} $dictv {
+	lappend values $v
+	set k
+    }]
+    set result [expr {
+	$keys eq [dict keys $dictv] && $values eq [dict values $dictv]
+    }]
+    expr {$result ? "YES" : [list "NO" $dictv $keys $values]}
+} -cleanup {
+    unset result keys values k v dictv
+} -result YES
+test dict-24.9 {dict map command} {
+    dict map {k v} {} {
+	error "unexpected execution of 'dict map' body"
+    }
+} {}
+test dict-24.10 {dict map command: script results} -body {
+    set times 0
+    dict map {k v} {a a b b} {
+	incr times
+	continue
+	error "shouldn't get here"
+    }
+    return $times
+} -cleanup {
+    unset times k v
+} -result 2
+test dict-24.11 {dict map command: script results} -body {
+    set times 0
+    dict map {k v} {a a b b} {
+	incr times
+	break
+	error "shouldn't get here"
+    }
+    return $times
+} -cleanup {
+    unset times k v
+} -result 1
+test dict-24.12 {dict map command: script results} -body {
+    set times 0
+    list [catch {
+	dict map {k v} {a a b b} {
+	    incr times
+	    error test
+	}
+    } msg] $msg $times $::errorInfo
+} -cleanup {
+    unset times k v msg
+} -result {1 test 1 {test
+    while executing
+"error test"
+    ("dict map" body line 3)
+    invoked from within
+"dict map {k v} {a a b b} {
+	    incr times
+	    error test
+	}"}}
+test dict-24.13 {dict map command: script results} {
+    apply {{} {
+	dict map {k v} {a b} {
+	    return ok,$k,$v
+	    error "skipped return completely"
+	}
+	error "return didn't go far enough"
+    }}
+} ok,a,b
+test dict-24.14 {dict map command: handle representation loss} -body {
+    set dictVar {a b c d e f g h}
+    set values {}
+    set keys [dict map {k v} $dictVar {
+	if {[llength $dictVar]} {
+	    lappend values $v
+	    return -level 0 $k
+	}
+    }]
+    list [lsort $keys] [lsort $values]
+} -cleanup {
+    unset dictVar keys values k v
+} -result {{a c e g} {b d f h}}
+test dict-24.15 {dict map command: keys are unique and iterated over once only} -setup {
+    unset -nocomplain accum
+    array set accum {}
+} -body {
+    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
+    dict map {k v} $dictVar {
+	append accum($k) $v,
+    }
+    set result [lsort [array names accum]]
+    lappend result :
+    foreach k $result {
+	catch {lappend result $accum($k)}
+    }
+    return $result
+} -cleanup {
+    unset dictVar k v result accum
+} -result {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
+test dict-24.16 {dict map command in compilation context} {
+    apply {{} {
+	set res {x x x x x x}
+	dict map {k v} {a 0 b 1 c 2 d 3 e 4 f 5} {
+	    lset res $v $k
+	    continue
+	}
+	return $res
+    }}
+} {a b c d e f}
+test dict-24.17 {dict map command in compilation context} {
+    # Bug 1379349 (dict for)
+    apply {{} {
+	set d [dict create a 1]		;# Dict must be unshared!
+	dict map {k v} $d {
+	    dict set d $k 0		;# Any modification will do
+	}
+	return $d
+    }}
+} {a 0}
+test dict-24.17a {dict map command in compilation context} {
+    # Bug 1379349 (dict for)
+    apply {{} {
+	set d [dict create a 1]		;# Dict must be unshared!
+	dict map {k v} $d {
+	    dict set d $k 0		;# Any modification will do
+	}
+    }}
+} {{a 0}}
+test dict-24.18 {dict map command in compilation context} {
+    # Bug 1382528 (dict for)
+    apply {{} {
+	dict map {k v} {} {}		;# Note empty dict
+	catch { error foo }		;# Note compiled [catch]
+    }}
+} 1
+test dict-24.19 {dict map and invalid dicts: 'dict for' bug 1531184} -body {
+    di[list]ct map {k v} x {}
+} -returnCodes 1 -result {missing value to go with key}
+test dict-24.20 {dict map stack space compilation: 'dict for' bug 1903325} {
+    apply {{x y args} {
+	dict map {a b} $x {}
+	concat "c=$y,$args"
+    }} {} 1 2 3
+} {c=1,2 3}
+proc linenumber {} {
+    dict get [info frame -1] line
+}
+test dict-24.20 {dict compilation crash: 'dict for' bug 3487626} {
+    apply {{} {apply {n {
+	set e {}
+	set k {}
+	dict map {a b} {c {d {e {f g}}}} {
+	    ::tcl::dict::map {h i} $b {
+		dict update i e j {
+		    ::tcl::dict::update j f k {
+			return [expr {$n - [linenumber]}]
+		    }
+		}
+	    }
+	}
+    }} [linenumber]}}
+} 5
+test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} knownBug {
+    apply {{} {apply {n {
+	set e {}
+	set k {}
+	dict map {a {
+b
+}} {c {d {e {f g}}}} {
+	    ::tcl::dict::map {h {
+i
+}} ${
+b
+} {
+		dict update {
+i
+} e {
+j
+} {
+		    ::tcl::dict::update {
+j
+} f k {
+			return [expr {$n - [linenumber]}]
+		    }
+		}
+	    }
+	}
+    }} [linenumber]}}
+} 5
+rename linenumber {}
+test dict-24.22 {dict map results (non-compiled)} {
+    dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
+	return -level 0 "$k,$v"
+    }
+} {{1 a,2 b} {3 c,4 d}}
+test dict-24.23 {dict map results (compiled)} {
+    apply {{} {
+	dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
+	    return -level 0 "$k,$v"
+	}
+    }}
+} {{1 a,2 b} {3 c,4 d}}
+test dict-24.23a {dict map results (compiled)} {
+    apply {{list} {
+	dict map {k v} [dict map {k v} $list { list $v $k }] {
+	    return -level 0 "$k,$v"
+	}
+    }} {a 1 b 2 c 3 d 4}
+} {{1 a,2 b} {3 c,4 d}}
+test dict-24.24 {dict map with huge dict (non-compiled)} {
+    tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat 1000000 x] x] {
+	expr { $k * $v }
+    }]
+} 166666416666500000
+test dict-24.25 {dict map with huge dict (compiled)} {
+    apply {{n} {
+	tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat $n y] y] {
+	    expr { $k * $v }
+	}]
+    }} 1000000
+} 166666416666500000
+
 
 # cleanup
 ::tcltest::cleanupTests
diff --git a/tests/foreach.test b/tests/foreach.test
index a4b652a..6c69b29 100644
--- a/tests/foreach.test
+++ b/tests/foreach.test
@@ -266,6 +266,15 @@ test foreach-10.1 {foreach: [Bug 1671087]} -setup {
     rename demo {}
 } -result {}
 
+test foreach-11.1 {error then dereference loop var (dev bug)} {
+  catch { foreach a 0 b {1 2 3} { error x } }
+  set a
+} 0
+test foreach-11.2 {error then dereference loop var (dev bug)} {
+  catch { foreach a 0 b {1 2 3} { incr a $b; error x } }
+  set a
+} 1
+
 # cleanup
 catch {unset a}
 catch {unset x}
diff --git a/tests/foreacha.test b/tests/foreacha.test
new file mode 100644
index 0000000..09a90e4
--- /dev/null
+++ b/tests/foreacha.test
@@ -0,0 +1,217 @@
+# Commands covered:  foreach, 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+catch {unset a}
+catch {unset x}
+
+# ----- Basic "foreacha" operation (non-compiled) ------------------------------
+
+test foreacha-1.1 {basic foreacha tests (non-compiled) - foldl/reduce with initial value} {
+    set x {}
+    set c [foreacha a 0 b {1 2 3 4} { lappend x $a ; incr a $b }]
+    list $a $b $c $x
+} {10 4 10 {0 1 3 6}}
+
+test foreacha-1.2 {basic foreacha tests (non-compiled) - foldl/reduce without initial value} {
+    set x {}
+    set c [foreacha {a b} {1 2 3 4 5 6} { lappend x $a ; incr a $b }]
+    list $a $b $c $x
+} {21 6 21 {1 3 6 10 15}}
+
+test foreacha-1.3 {basic foreacha tests (non-compiled) - filter} {
+    foreacha a {} b {1 2 3 4 5 6} { if { ($b % 2)==0 } { lappend a $b } }
+} {2 4 6}
+
+test foreacha-1.3.1 {basic foreacha tests (non-compiled) - filter (via continue)} {
+    foreacha a {} b {1 2 3 4 5 6} { if { ($b % 2)==0 } continue; lappend a $b }
+} {1 3 5}
+
+test foreacha-1.4 {basic foreacha tests (non-compiled) - map} {
+    foreacha a {} b {1 2 3 4 5 6} { lappend a [lrepeat $b $b] }
+} {1 {2 2} {3 3 3} {4 4 4 4} {5 5 5 5 5} {6 6 6 6 6 6}}
+
+test foreacha-1.5 {basic foreacha tests (non-compiled) - prefix (via break)} {
+    foreacha a {} b {1 2 3 4 5 6} { if { $b > 4 } break; lappend a $b }
+} {1 2 3 4}
+
+test foreacha-1.6 {basic foreacha tests (non-compiled) - accumulator doesn't iterate} {
+    set x {}
+    set b [foreacha a {1 2 3 4} { lappend x $a }]
+    list $a $b $x
+} {1 1 1}
+
+test foreacha-1.7 {basic foreacha tests (non-compiled) - accumulator doesn't iterate} {
+    set x {}
+    set c [foreacha a {1 2 3 4} b 0 { lappend x $a $b ; append a $b ; append b $a }]
+    list $a $b $c $x
+} {10 010 10 {1 0}}
+
+test foreacha-1.8 {basic foreacha tests (non-compiled) - huge list} {
+    foreacha {a b} [lsearch -all [lrepeat 1000000 x] x] { incr a $b }
+} 499999500000
+
+test foreacha-1.9 {basic foreacha tests (non-compiled) - spaghetti} {
+    foreacha {a b} [foreacha a {} {b c} [lsearch -all [lrepeat 1000 x] x] {
+	lappend a [expr { $b * $c }]
+    }] {
+	incr a $b
+    }
+} 166416500
+
+test foreacha-1.9.1 {basic foreacha tests (non-compiled) - spaghetti with mapeach} {
+    foreacha {a b} [mapeach {b c} [lsearch -all [lrepeat 1000 x] x] {
+	expr { $b * $c }
+    }] {
+	incr a $b
+    }
+} 166416500
+
+test foreacha-1.10 {basic foreacha tests (non-compiled) - nested} {
+    foreacha {a b} [lsearch -all [lrepeat 1000 x] x] {
+	incr a [foreacha c 10 d [lrepeat $b $b] { incr c $b }]
+    }
+} 332843490
+
+test foreacha-1.10.1 {basic foreacha tests (non-compiled) - nested with loop var collision} {
+    foreacha {a b} [lsearch -all [lrepeat 1000 x] x] {
+	foreacha a 10 b [lrepeat $b $b] { incr a $b }
+    }
+} 998011
+
+test foreacha-1.10.2 {basic foreacha tests (non-compiled) - nested, inner non-compiled} {
+    foreacha {a b} [lsearch -all [lrepeat 1000 x] x] {
+	incr a [eval foreacha c 10 d [list [lrepeat $b $b] { incr c $b }]]
+    }
+} 332843490
+
+
+# ----- Basic "foreacha" operation (compiled) ----------------------------------
+
+test foreacha-2.1 {basic foreacha tests (compiled) - foldl/reduce with initial value} {
+    apply {{} {
+	set x {}
+	set c [foreacha a 0 b {1 2 3 4} { lappend x $a ; incr a $b }]
+	list $a $b $c $x
+    }}
+} {10 4 10 {0 1 3 6}}
+
+test foreacha-2.2 {basic foreacha tests (compiled) - foldl/reduce without initial value} {
+    apply {{} {
+	set x {}
+	set c [foreacha {a b} {1 2 3 4 5 6} { lappend x $a ; incr a $b }]
+	list $a $b $c $x
+    }}
+} {21 6 21 {1 3 6 10 15}}
+
+test foreacha-2.3 {basic foreacha tests (compiled) - filter} {
+    apply {{} {
+	foreacha a {} b {1 2 3 4 5 6} { if { ($b % 2)==0 } { lappend a $b } }
+    }}
+} {2 4 6}
+
+test foreacha-2.3.1 {basic foreacha tests (non-compiled) - filter (via continue)} {
+    apply {{} {
+	foreacha a {} b {1 2 3 4 5 6} { if { ($b % 2)==0 } continue; lappend a $b }
+    }}
+} {1 3 5}
+
+test foreacha-2.4 {basic foreacha tests (compiled) - map} {
+    apply {{} {
+	foreacha a {} b {1 2 3 4 5 6} { lappend a [lrepeat $b $b] }
+    }}
+} {1 {2 2} {3 3 3} {4 4 4 4} {5 5 5 5 5} {6 6 6 6 6 6}}
+
+test foreacha-2.5 {basic foreacha tests (non-compiled) - prefix (via break)} {
+    apply {{} {
+	foreacha a {} b {1 2 3 4 5 6} { if { $b > 4 } break; lappend a $b }
+    }}
+} {1 2 3 4}
+
+test foreacha-2.6 {basic foreacha tests (compiled) - accumulator doesn't iterate} {
+    apply {{} {
+	set x {}
+	set b [foreacha a {1 2 3 4} { lappend x $a }]
+	list $a $b $x
+    }}
+} {1 1 1}
+
+test foreacha-2.7 {basic foreacha tests (compiled) - accumulator doesn't iterate} {
+    apply {{} {
+	set x {}
+	set c [foreacha a {1 2 3 4} b 0 { lappend x $a $b ; append a $b ; append b $a }]
+	list $a $b $c $x
+    }}
+} {10 010 10 {1 0}}
+
+test foreacha-2.8 {basic foreacha tests (compiled) - huge list} {
+    apply {{} {
+	foreacha {a b} [lsearch -all [lrepeat 1000000 x] x] { incr a $b }
+    }}
+} 499999500000
+
+test foreacha-2.9 {basic foreacha tests (compiled) - spaghetti} {
+    apply {{} {
+	foreacha {a b} [foreacha a {} {b c} [lsearch -all [lrepeat 1000 x] x] {
+	    lappend a [expr { $b * $c }]
+	}] {
+	    incr a $b
+	}
+    }}
+} 166416500
+
+test foreacha-2.9.1 {basic foreacha tests (compiled) - spaghetti with mapeach} {
+    apply {{} {
+	foreacha {a b} [mapeach {b c} [lsearch -all [lrepeat 1000 x] x] {
+	    expr { $b * $c }
+	}] {
+	    incr a $b
+	}
+    }}
+} 166416500
+
+test foreacha-2.10 {basic foreacha tests (compiled) - nested} {
+    apply {{} {
+	foreacha {a b} [lsearch -all [lrepeat 1000 x] x] {
+	    incr a [foreacha c 10 d [lrepeat $b $b] { incr c $b }]
+	}
+    }}
+} 332843490
+
+test foreacha-2.10.1 {basic foreacha tests (compiled) - nested with loop var collision} {
+    apply {{} {
+	foreacha {a b} [lsearch -all [lrepeat 1000 x] x] {
+	    foreacha a 10 b [lrepeat $b $b] { incr a $b }
+	}
+    }}
+} 998011
+
+test foreacha-2.10.2 {basic foreacha tests (compiled) - nested, inner non-compiled} {
+    apply {{} {
+	foreacha {a b} [lsearch -all [lrepeat 1000 x] x] {
+	    incr a [eval foreacha c 10 d [list [lrepeat $b $b] { incr c $b }]]
+	}
+    }}
+} 332843490
+
+
+
+# cleanup
+catch {unset a}
+catch {unset x}
+catch {rename foo {}}
+::tcltest::cleanupTests
+return
diff --git a/tests/mapeach.test b/tests/mapeach.test
new file mode 100644
index 0000000..9ad9d72
--- /dev/null
+++ b/tests/mapeach.test
@@ -0,0 +1,493 @@
+# 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}
+
+test mapeach-7.9 {error then dereference loop var (dev bug)} {
+  catch { mapeach a 0 b {1 2 3} { error x } }
+  set a
+} 0
+test mapeach-7.9a {error then dereference loop var (dev bug)} {
+  catch { mapeach a 0 b {1 2 3} { incr a $b; error x } }
+  set a
+} 1
+
+# ----- 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