merge trunk

4 files changed, 900 insertions, 2 deletions

diff --git a/tests/dict.test b/tests/dict.test
index 77bacf6..aa22c00 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -1521,6 +1521,268 @@ 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} -setup {
+    set values {}
+    set keys {}
+} -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}
+    dict map {k v} $dictv {
+	lappend keys $k
+	lappend values $v
+    }
+    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} -setup {
+    set keys {}
+    set values {}
+} -body {
+    set dictVar {a b c d e f g h}
+    list [dict size [dict map {k v} $dictVar {
+	if {[llength $dictVar]} {
+	    lappend keys $k
+	    lappend values $v
+	    return -level 0 $k
+	}
+    }]] [lsort $keys] [lsort $values]
+} -cleanup {
+    unset dictVar keys values k v
+} -result {4 {a c e g} {b d f h}}
+test dict-24.14a {dict map command: handle representation loss} -body {
+    apply {{} {
+	set dictVar {a b c d e f g h}
+	list [dict size [dict map {k v} $dictVar {
+	    if {[llength $dictVar]} {
+		lappend keys $k
+		lappend values $v
+		return -level 0 $k
+	    }
+	}]] [lsort $keys] [lsort $values]
+    }}
+} -result {4 {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 {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"
+    }
+} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,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"
+	}
+    }}
+} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,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}
+} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
+test dict-24.24 {dict map with huge dict (non-compiled)} {
+    tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat 100000 x] x] {
+	expr { $k * $v }
+    }]
+} 166666666600000
+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 }
+	}]
+    }} 100000
+} 166666666600000
+
 
 # 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/lmap.test b/tests/lmap.test
new file mode 100644
index 0000000..7baa77b
--- /dev/null
+++ b/tests/lmap.test
@@ -0,0 +1,464 @@
+# 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 {"::tcltest" ni [namespace children]} {
+    package require tcltest 2
+    namespace import -force ::tcltest::*
+}
+
+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} {
+	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.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
+    }
+} {}
+test lmap-1.12 {basic lmap tests} {
+    lmap i {} {
+	return -level 0 x
+    }
+} {}
+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
+} -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} -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
+    }
+} {{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} -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
+	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.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 } }}
+} {}
+test lmap-4.12 {basic lmap tests} {
+    apply {{} { lmap i {} { return -level 0 x } }}
+} {}
+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 
+    }} 
+} {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} -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
+	}
+    }}
+} {{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} -setup {
+    unset -nocomplain x
+} -body {
+    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]
+} -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]
+    }
+} -result {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
+       "
+       return $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} -returnCodes error -body {
+    proc foo {} {
+	lmap {} x {
+	    error "reached body"
+	}
+    }
+    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}
+	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} -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
+unset -nocomplain a x
+catch {rename foo {}}
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/zlib.test b/tests/zlib.test
index 8212082..5f1e5fc 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -10,7 +10,7 @@
 # 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} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2.1
     namespace import -force ::tcltest::*
 }
@@ -23,6 +23,12 @@ test zlib-1.1 {zlib basics} -constraints zlib -returnCodes error -body {
 test zlib-1.2 {zlib basics} -constraints zlib -returnCodes error -body {
     zlib ? {}
 } -result {bad command "?": must be adler32, compress, crc32, decompress, deflate, gunzip, gzip, inflate, push, or stream}
+test zlib-1.3 {zlib basics} -constraints zlib -body {
+    zlib::pkgconfig list
+} -result zlibVersion
+test zlib-1.4 {zlib basics} -constraints zlib -body {
+    package present zlib
+} -result 2.0
 
 test zlib-2.1 {zlib compress/decompress} zlib {
     zlib decompress [zlib compress abcdefghijklm]
@@ -70,7 +76,7 @@ test zlib-7.0 {zlib stream} -constraints zlib -returnCodes error -setup {
     $s ?
 } -cleanup {
     $s close
-} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, put, or reset}
+} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, header, put, or reset}
 test zlib-7.1 {zlib stream} zlib {
     set s [zlib stream compress]
     $s put -finalize abcdeEDCBA
@@ -203,6 +209,163 @@ test zlib-8.5 {transformation and flushing and fileevents: Bug 3525907} -setup {
 } -cleanup {
     catch {close $r}
 } -result {qwertyuiop MIDDLE asdfghjkl}
+test zlib-8.6 {transformation and fconfigure} -setup {
+    set file [makeFile {} test.z]
+    set fd [open $file wb]
+} -constraints zlib -body {
+    list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \
+	[chan pop $fd; fconfigure $fd]
+} -cleanup {
+    catch {close $fd}
+    removeFile $file
+} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
+test zlib-8.7 {transformation and fconfigure} -setup {
+    set file [makeFile {} test.gz]
+    set fd [open $file wb]
+} -constraints zlib -body {
+    list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \
+	[chan pop $fd; fconfigure $fd]
+} -cleanup {
+    catch {close $fd}
+    removeFile $file
+} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
+# Input is headers from fetching SPDY draft
+# Dictionary is that which is proposed _in_ SPDY draft
+set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n"
+set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl"
+test zlib-8.8 {transformtion and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+} -constraints zlib -body {
+    zlib push compress $outSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -translation binary -buffering none
+    fconfigure $inSide -blocking 0 -translation binary
+    puts -nonewline $outSide $spdyHeaders
+    chan pop $outSide
+    set compressed [read $inSide]
+    catch {zlib decompress $compressed} err opt
+    list [string length [zlib compress $spdyHeaders]] \
+	[string length $compressed] \
+	$err [dict get $opt -errorcode] [zlib adler32 $spdyDict]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+} -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010}
+test zlib-8.9 {transformtion and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream decompress]
+} -constraints zlib -body {
+    zlib push compress $outSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -translation binary -buffering none
+    fconfigure $inSide -blocking 0 -translation binary
+    puts -nonewline $outSide $spdyHeaders
+    set result [fconfigure $outSide -checksum]
+    chan pop $outSide
+    $strm put -dictionary $spdyDict [read $inSide]
+    lappend result [string length $spdyHeaders] [string length [$strm get]]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {3064818174 358 358}
+test zlib-8.10 {transformtion and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+} -constraints zlib -body {
+    zlib push deflate $outSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -translation binary -buffering none
+    fconfigure $inSide -blocking 0 -translation binary
+    puts -nonewline $outSide $spdyHeaders
+    chan pop $outSide
+    set compressed [read $inSide]
+    catch {zlib inflate $compressed} err opt
+    list [string length [zlib deflate $spdyHeaders]] \
+	[string length $compressed] \
+	$err [dict get $opt -errorcode]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+} -result {254 212 {data error} {TCL ZLIB DATA}}
+test zlib-8.11 {transformtion and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream inflate]
+} -constraints zlib -body {
+    zlib push deflate $outSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -translation binary -buffering none
+    fconfigure $inSide -blocking 0 -translation binary
+    puts -nonewline $outSide $spdyHeaders
+    chan pop $outSide
+    $strm put -dictionary $spdyDict [read $inSide]
+    list [string length $spdyHeaders] [string length [$strm get]]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358}
+test zlib-8.12 {transformtion and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream compress]
+} -constraints zlib -body {
+    $strm put -dictionary $spdyDict -finalize $spdyHeaders
+    zlib push decompress $inSide
+    fconfigure $outSide -blocking 0 -translation binary
+    fconfigure $inSide -translation binary -dictionary $spdyDict
+    puts -nonewline $outSide [$strm get]
+    close $outSide
+    list [string length $spdyHeaders] [string length [read $inSide]] \
+	[fconfigure $inSide -checksum]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358 3064818174}
+test zlib-8.13 {transformtion and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream compress]
+} -constraints zlib -body {
+    $strm put -dictionary $spdyDict -finalize $spdyHeaders
+    zlib push decompress $inSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -translation binary
+    fconfigure $inSide -translation binary
+    puts -nonewline $outSide [$strm get]
+    close $outSide
+    list [string length $spdyHeaders] [string length [read $inSide]] \
+	[fconfigure $inSide -checksum]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358 3064818174}
+test zlib-8.14 {transformtion and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream deflate]
+} -constraints zlib -body {
+    $strm put -finalize -dictionary $spdyDict $spdyHeaders
+    zlib push inflate $inSide
+    fconfigure $outSide -blocking 0 -buffering none -translation binary
+    fconfigure $inSide -translation binary -dictionary $spdyDict
+    puts -nonewline $outSide [$strm get]
+    close $outSide
+    list [string length $spdyHeaders] [string length [read $inSide]]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358}
+test zlib-8.15 {transformtion and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream deflate]
+} -constraints zlib -body {
+    $strm put -finalize -dictionary $spdyDict $spdyHeaders
+    zlib push inflate $inSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -buffering none -translation binary
+    fconfigure $inSide -translation binary
+    puts -nonewline $outSide [$strm get]
+    close $outSide
+    list [string length $spdyHeaders] [string length [read $inSide]]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358}
 
 test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
     set sfile [makeFile {} testsrc.gz]