diff options
| -rw-r--r-- | ChangeLog | 15 | ||||
| -rw-r--r-- | doc/mapeach.n | 91 | ||||
| -rw-r--r-- | tests/foreacha.test | 217 | ||||
| -rw-r--r-- | tests/mapeach.test | 493 |
4 files changed, 15 insertions, 801 deletions
@@ -1,5 +1,20 @@ 2012-10-16 Donal K. Fellows <dkf@users.sf.net> + IMPLEMENTATION OF TIP#405 + + New commands for applying a transformation to the elements of a list + to produce another list (the [lmap] command) and to the mappings of a + dictionary to produce another dictionary (the [dict map] command). In + both cases, a [continue] will cause the skipping of an element/pair, + and a [break] will terminate the construction early and successfully. + + * generic/tclCmdAH.c (Tcl_LmapObjCmd, TclNRLmapCmd): Implementation of + the new [lmap] command, based on (and sharing much of) [foreach]. + * generic/tclDictObj.c (DictMapNRCmd): Implementation of the new [dict + map] subcommand, based on (and sharing much of) [dict for]. + * generic/tclCompCmds.c (TclCompileLmapCmd, TclCompileDictMapCmd): + Compilation engines for [lmap] and [dict map]. + IMPLEMENTATION OF TIP#400 * generic/tclZlib.c: Allow the specification of a compression diff --git a/doc/mapeach.n b/doc/mapeach.n deleted file mode 100644 index c89f7d9..0000000 --- a/doc/mapeach.n +++ /dev/null @@ -1,91 +0,0 @@ -'\" -'\" Copyright (c) 2012 Trevor Davel -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.so man.macros -.TH mapeach n "" Tcl "Tcl Built-In Commands" -.BS -'\" Note: do not modify the .SH NAME line immediately below! -.SH NAME -mapeach \- Iterate over all elements in one or more lists and collect results -.SH SYNOPSIS -\fBmapeach \fIvarname list body\fR -.br -\fBmapeach \fIvarlist1 list1\fR ?\fIvarlist2 list2 ...\fR? \fIbody\fR -.BE - -.SH DESCRIPTION -.PP -The \fBmapeach\fR command implements a loop where the loop -variable(s) take on values from one or more lists, and the loop returns a list -of results collected from each iteration. -.PP -In the simplest case there is one loop variable, \fIvarname\fR, -and one list, \fIlist\fR, that is a list of values to assign to \fIvarname\fR. -The \fIbody\fR argument is a Tcl script. -For each element of \fIlist\fR (in order -from first to last), \fBmapeach\fR assigns the contents of the -element to \fIvarname\fR as if the \fBlindex\fR command had been used -to extract the element, then calls the Tcl interpreter to execute -\fIbody\fR. If execution of the body completes normally then the result of the -body is appended to an accumulator list. \fBmapeach\fR returns the accumulator -list. - -.PP -In the general case there can be more than one value list -(e.g., \fIlist1\fR and \fIlist2\fR), -and each value list can be associated with a list of loop variables -(e.g., \fIvarlist1\fR and \fIvarlist2\fR). -During each iteration of the loop -the variables of each \fIvarlist\fR are assigned -consecutive values from the corresponding \fIlist\fR. -Values in each \fIlist\fR are used in order from first to last, -and each value is used exactly once. -The total number of loop iterations is large enough to use -up all the values from all the value lists. -If a value list does not contain enough -elements for each of its loop variables in each iteration, -empty values are used for the missing elements. -.PP -The \fBbreak\fR and \fBcontinue\fR statements may be -invoked inside \fIbody\fR, with the same effect as in the \fBfor\fR -and \fBforeach\fR commands. In these cases the body does not complete normally -and the result is not appended to the accumulator list. -.SH EXAMPLES -.PP -Zip lists together: -.PP -.CS -'\" Maintainers: notice the tab hacking below! -.ta 3i -set list1 {a b c d} -set list2 {1 2 3 4} -set zipped [\fBmapeach\fR a $list1 b $list2 {list $a $b}] -# The value of zipped is "{a 1} {b 2} {c 3} {d 4}" -.CE -.PP -Filter a list: -.PP -.CS -set values {1 2 3 4 5 6 7 8} -proc isGood {n} { expr { ($n % 2) == 0 } } -set goodOnes [\fBmapeach\fR x $values {expr {[isGood $x] ? $x : [continue]}}] -# The value of goodOnes is "2 4 6 8" -.CE -.PP -Take a prefix from a list: -.PP -.CS -set values {8 7 6 5 4 3 2 1} -proc isGood {n} { expr { $n > 3 } } -set prefix [\fBmapeach\fR x $values {expr {[isGood $x] ? $x : [break]}}] -# The value of prefix is "8 7 6 5 4" -.CE - -.SH "SEE ALSO" -for(n), while(n), break(n), continue(n), foreach(n) - -.SH KEYWORDS -foreach, iteration, list, loop, map diff --git a/tests/foreacha.test b/tests/foreacha.test deleted file mode 100644 index 09a90e4..0000000 --- a/tests/foreacha.test +++ /dev/null @@ -1,217 +0,0 @@ -# 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 deleted file mode 100644 index 9ad9d72..0000000 --- a/tests/mapeach.test +++ /dev/null @@ -1,493 +0,0 @@ -# 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 |