summaryrefslogtreecommitdiffstats
path: root/tests/lmap.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/lmap.test')
-rw-r--r--tests/lmap.test471
1 files changed, 221 insertions, 250 deletions
diff --git a/tests/lmap.test b/tests/lmap.test
index dc5053f..7baa77b 100644
--- a/tests/lmap.test
+++ b/tests/lmap.test
@@ -13,20 +13,16 @@
#
# RCS: @(#) $Id: $
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2
namespace import -force ::tcltest::*
}
-catch {unset a}
-catch {unset i}
-catch {unset x}
-
-# ----- Non-compiled operation -------------------------------------------------
-
+unset -nocomplain a i x
+
+# ----- Non-compiled operation -----------------------------------------------
# Basic "lmap" operation (non-compiled)
-
test lmap-1.1 {basic lmap tests} {
set a {}
lmap i {a b c d} {
@@ -40,62 +36,53 @@ test lmap-1.2 {basic lmap tests} {
} {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
+ 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.4 {basic lmap tests} -returnCodes error -body {
+ lmap
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.6 {basic lmap tests} -returnCodes error -body {
+ lmap i
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.8 {basic lmap tests} -returnCodes error -body {
+ lmap i j
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.10 {basic lmap tests} -returnCodes error -body {
+ lmap i j k l
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
test lmap-1.11 {basic lmap tests} {
lmap i {} {
- set i
+ set i
}
} {}
test lmap-1.12 {basic lmap tests} {
lmap i {} {
- return -level 0 x
+ 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}
+test lmap-1.13 {lmap errors} -returnCodes error -body {
+ lmap {{a}{b}} {1 2 3} {}
+} -result {list element in braces followed by "{b}" instead of space}
+test lmap-1.14 {lmap errors} -returnCodes error -body {
+ lmap a {{1 2}3} {}
+} -result {list element in braces followed by "3" instead of space}
+unset -nocomplain a
+test lmap-1.15 {lmap errors} -setup {
+ unset -nocomplain a
+} -body {
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")
+} -result {1 {can't set "a": variable is array} {can't set "a": variable is array
+ (setting lmap 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}
-
+test lmap-1.16 {lmap errors} -returnCodes error -body {
+ lmap {} {} {}
+} -result {lmap varlist is empty}
+unset -nocomplain a
# Parallel "lmap" operation (non-compiled)
-
test lmap-2.1 {parallel lmap tests} {
lmap {a b} {1 2 3 4} {
list $b $a
@@ -137,23 +124,22 @@ test lmap-2.8 {parallel lmap tests} {
}
} {{.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
+ 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 }
-
+test lmap-2.10 {lmap only supports local scalar variables} -setup {
+ unset -nocomplain a
+} -body {
+ lmap {a(3)} {1 2 3 4} {set {a(3)}}
+} -result {1 2 3 4}
+unset -nocomplain 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
@@ -171,149 +157,139 @@ test lmap-3.2 {continue tests} {
test lmap-3.3 {break tests} {
set x 0
list [lmap i {a b c d} {
- incr x
+ 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
+ set a 1
+ lmap b b {list [concat a; break]; incr a}
+ incr a
} {2}
-
-# ----- Compiled operation ------------------------------------------------------
+# ----- 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]
- }
- }}
+ 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
- }
- }}
+ 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
- }
- }}
+ 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.4 {basic lmap tests} -returnCodes error -body {
+ apply {{} { lmap }}
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.6 {basic lmap tests} -returnCodes error -body {
+ apply {{} { lmap i }}
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.8 {basic lmap tests} -returnCodes error -body {
+ apply {{} { lmap i j }}
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.10 {basic lmap tests} -returnCodes error -body {
+ apply {{} { lmap i j k l }}
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
test lmap-4.11 {basic lmap tests} {
- apply {{} { lmap i {} { set i } }}
+ apply {{} { lmap i {} { set i } }}
} {}
test lmap-4.12 {basic lmap tests} {
- apply {{} { lmap i {} { return -level 0 x } }}
+ 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.13 {lmap errors} -returnCodes error -body {
+ apply {{} { lmap {{a}{b}} {1 2 3} {} }}
+} -result {list element in braces followed by "{b}" instead of space}
+test lmap-4.14 {lmap errors} -returnCodes error -body {
+ apply {{} { lmap a {{1 2}3} {} }}
+} -result {list element in braces followed by "3" instead of space}
+unset -nocomplain a
test lmap-4.15 {lmap errors} {
apply {{} {
- set a(0) 44
- list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
+ 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}
-
+test lmap-4.16 {lmap errors} -returnCodes error -body {
+ apply {{} {
+ lmap {} {} {}
+ }}
+} -result {lmap varlist is empty}
+unset -nocomplain a
# Parallel "lmap" operation (compiled)
-
test lmap-5.1 {parallel lmap tests} {
- apply {{} {
- lmap {a b} {1 2 3 4} {
- list $b $a
- }
- }}
+ 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
- }
- }}
+ 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
- }
- }}
+ 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
- }
- }}
+ 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
- }
- }}
+ 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
- }
- }}
+ 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
- }
- }}
+ 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] .
- }
- }}
+ 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 {{} {
@@ -328,34 +304,32 @@ test lmap-5.10 {lmap only supports local scalar variables} {
}}
} {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
- }
- }}
+ 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
- }}
+ 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
- }}
+ 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} {
@@ -366,13 +340,10 @@ test lmap-6.4 {break tests} {
}}
} {2}
-
-
-# ----- Special cases and bugs -------------------------------------------------
-
-
-test lmap-7.1 {compiled lmap backward jump works correctly} {
- catch {unset x}
+# ----- Special cases and bugs -----------------------------------------------
+test lmap-7.1 {compiled lmap backward jump works correctly} -setup {
+ unset -nocomplain x
+} -body {
array set x {0 zero 1 one 2 two 3 three}
lsort [apply {{arrayName} {
upvar 1 $arrayName a
@@ -380,16 +351,15 @@ test lmap-7.1 {compiled lmap backward jump works correctly} {
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}
+} -result [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} -setup {
+ unset -nocomplain x
+} -body {
lmap {12.0} {a b c} {
set x 12.0
set x [expr $x + 1]
}
-} {13.0 13.0 13.0}
-
+} -result {13.0 13.0 13.0}
# Test for incorrect "double evaluation" semantics
test lmap-7.3 {delayed substitution of body} {
apply {{} {
@@ -397,10 +367,9 @@ test lmap-7.3 {delayed substitution of body} {
lmap a [list 1 2 3] "
set x $a
"
- set x
+ return $x
}}
} {0}
-
# Related to "foreach" test for [Bug 1189274]; crash on failure
test lmap-7.4 {empty list handling} {
proc crash {} {
@@ -411,17 +380,18 @@ test lmap-7.4 {empty list handling} {
}
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} {
+# Related to [Bug 1671138]; infinite loop with empty var list in bytecompiled
+# version.
+test lmap-7.5 {compiled empty var list} -returnCodes error -body {
proc foo {} {
lmap {} x {
error "reached body"
}
}
- list [catch { foo } msg] $msg
-} {1 {foreach varlist is empty}}
-
+ foo
+} -cleanup {
+ catch {rename foo ""}
+} -result {lmap varlist is empty}
test lmap-7.6 {lmap: related to "foreach" [Bug 1671087]} -setup {
proc demo {} {
set vals {1 2 3 4}
@@ -433,61 +403,62 @@ test lmap-7.6 {lmap: related to "foreach" [Bug 1671087]} -setup {
} -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]
+ 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]
+ 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
+ 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
+ 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} {}}
-
-
+# ----- Coroutines -----------------------------------------------------------
+test lmap-8.1 {lmap non-compiled with coroutines} -body {
+ 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]
+} -cleanup {
+ catch {rename coro ""}
+} -result {{1 2 3 4 5 6} {}}
+test lmap-8.2 {lmap compiled with coroutines} -body {
+ 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]
+} -cleanup {
+ catch {rename coro ""}
+} -result {{1 2 3 4 5 6} {}}
+
# cleanup
-catch {unset a}
-catch {unset x}
+unset -nocomplain a x
catch {rename foo {}}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End: