diff options
Diffstat (limited to 'tcl8.6/tests/foreach.test')
| -rw-r--r-- | tcl8.6/tests/foreach.test | 296 |
1 files changed, 0 insertions, 296 deletions
diff --git a/tcl8.6/tests/foreach.test b/tcl8.6/tests/foreach.test deleted file mode 100644 index 84af4bd..0000000 --- a/tcl8.6/tests/foreach.test +++ /dev/null @@ -1,296 +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 "foreach" operation. - -test foreach-1.1 {basic foreach tests} { - set a {} - foreach i {a b c d} { - set a [concat $a $i] - } - set a -} {a b c d} -test foreach-1.2 {basic foreach tests} { - set a {} - foreach i {a b {{c d} e} {123 {{x}}}} { - set a [concat $a $i] - } - set a -} {a b {c d} e 123 {{x}}} -test foreach-1.3 {basic foreach tests} {catch {foreach} msg} 1 -test foreach-1.4 {basic foreach tests} { - catch {foreach} msg - set msg -} {wrong # args: should be "foreach varList list ?varList list ...? command"} -test foreach-1.5 {basic foreach tests} {catch {foreach i} msg} 1 -test foreach-1.6 {basic foreach tests} { - catch {foreach i} msg - set msg -} {wrong # args: should be "foreach varList list ?varList list ...? command"} -test foreach-1.7 {basic foreach tests} {catch {foreach i j} msg} 1 -test foreach-1.8 {basic foreach tests} { - catch {foreach i j} msg - set msg -} {wrong # args: should be "foreach varList list ?varList list ...? command"} -test foreach-1.9 {basic foreach tests} {catch {foreach i j k l} msg} 1 -test foreach-1.10 {basic foreach tests} { - catch {foreach i j k l} msg - set msg -} {wrong # args: should be "foreach varList list ?varList list ...? command"} -test foreach-1.11 {basic foreach tests} { - set a {} - foreach i {} { - set a [concat $a $i] - } - set a -} {} -test foreach-1.12 {foreach errors} { - list [catch {foreach {{a}{b}} {1 2 3} {}} msg] $msg -} {1 {list element in braces followed by "{b}" instead of space}} -test foreach-1.13 {foreach errors} { - list [catch {foreach a {{1 2}3} {}} msg] $msg -} {1 {list element in braces followed by "3" instead of space}} -catch {unset a} -test foreach-1.14 {foreach errors} { - catch {unset a} - set a(0) 44 - list [catch {foreach 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 -"foreach a {1 2 3} {}"}} -test foreach-1.15 {foreach errors} { - list [catch {foreach {} {} {}} msg] $msg -} {1 {foreach varlist is empty}} -catch {unset a} - -test foreach-2.1 {parallel foreach tests} { - set x {} - foreach {a b} {1 2 3 4} { - append x $b $a - } - set x -} {2143} -test foreach-2.2 {parallel foreach tests} { - set x {} - foreach {a b} {1 2 3 4 5} { - append x $b $a - } - set x -} {21435} -test foreach-2.3 {parallel foreach tests} { - set x {} - foreach a {1 2 3} b {4 5 6} { - append x $b $a - } - set x -} {415263} -test foreach-2.4 {parallel foreach tests} { - set x {} - foreach a {1 2 3} b {4 5 6 7 8} { - append x $b $a - } - set x -} {41526378} -test foreach-2.5 {parallel foreach tests} { - set x {} - foreach {a b} {a b A B aa bb} c {c C cc CC} { - append x $a $b $c - } - set x -} {abcABCaabbccCC} -test foreach-2.6 {parallel foreach tests} { - set x {} - foreach a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} { - append x $a $b $c $d $e - } - set x -} {111112222233333} -test foreach-2.7 {parallel foreach tests} { - set x {} - foreach a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} { - append x $a $b $c $d $e - } - set x -} {1111 2222334} -test foreach-2.8 {foreach only sets vars if repeating loop} { - proc foo {} { - set rgb {65535 0 0} - foreach {r g b} [set rgb] {} - return "r=$r, g=$g, b=$b" - } - foo -} {r=65535, g=0, b=0} -test foreach-2.9 {foreach only supports local scalar variables} { - proc foo {} { - set x {} - foreach {a(3)} {1 2 3 4} {lappend x [set {a(3)}]} - set x - } - foo -} {1 2 3 4} - -test foreach-3.1 {compiled foreach backward jump works correctly} { - catch {unset x} - proc foo {arrayName} { - upvar 1 $arrayName a - set l {} - foreach member [array names a] { - lappend l [list $member [set a($member)]] - } - return $l - } - array set x {0 zero 1 one 2 two 3 three} - lsort [foo x] -} [lsort {{0 zero} {1 one} {2 two} {3 three}}] - -test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} { - catch {unset x} - foreach {12.0} {a b c} { - set x 12.0 - set x [expr $x + 1] - } - set x -} 13.0 - -# Check "continue". - -test foreach-5.1 {continue tests} {catch continue} 4 -test foreach-5.2 {continue tests} { - set a {} - foreach i {a b c d} { - if {[string compare $i "b"] == 0} continue - set a [concat $a $i] - } - set a -} {a c d} -test foreach-5.3 {continue tests} { - set a {} - foreach i {a b c d} { - if {[string compare $i "b"] != 0} continue - set a [concat $a $i] - } - set a -} {b} -test foreach-5.4 {continue tests} {catch {continue foo} msg} 1 -test foreach-5.5 {continue tests} { - catch {continue foo} msg - set msg -} {wrong # args: should be "continue"} - -# Check "break". - -test foreach-6.1 {break tests} {catch break} 3 -test foreach-6.2 {break tests} { - set a {} - foreach i {a b c d} { - if {[string compare $i "c"] == 0} break - set a [concat $a $i] - } - set a -} {a b} -test foreach-6.3 {break tests} {catch {break foo} msg} 1 -test foreach-6.4 {break tests} { - catch {break foo} msg - set msg -} {wrong # args: should be "break"} -# Check for bug #406709 -test foreach-6.5 {break tests} -body { - proc a {} { - set a 1 - foreach b b {list [concat a; break]; incr a} - incr a - } - a -} -cleanup { - rename a {} -} -result {2} - -# Test for incorrect "double evaluation" semantics -test foreach-7.1 {delayed substitution of body} { - proc foo {} { - set a 0 - foreach a [list 1 2 3] " - set x $a - " - set x - } - foo -} {0} - -# Test for [Bug 1189274]; crash on failure -test foreach-8.1 {empty list handling} { - proc crash {} { - rename crash {} - set a "x y z" - set b "" - foreach aa $a bb $b { set x "aa = $aa bb = $bb" } - } - crash -} {} - -# [Bug 1671138]; infinite loop with empty var list in bytecompiled version -test foreach-9.1 {compiled empty var list} { - proc foo {} { - foreach {} x { - error "reached body" - } - } - list [catch { foo } msg] $msg -} {1 {foreach varlist is empty}} - -test foreach-9.2 {line numbers} -setup { - proc linenumber {} {dict get [info frame -1] line} -} -body { - apply {n { - foreach x y {*}{ - } {return [incr n -[linenumber]]} - }} [linenumber] -} -cleanup { - rename linenumber {} -} -result 1 - -test foreach-10.1 {foreach: [Bug 1671087]} -setup { - proc demo {} { - set vals {1 2 3 4} - trace add variable x write {string length $vals ;# } - foreach {x y} $vals {format $y} - } -} -body { - demo -} -cleanup { - 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} -catch {rename foo {}} -::tcltest::cleanupTests -return |