+++ /dev/null
-# 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} {
- proc a {} {
- set a 1
- foreach b b {list [concat a; break]; incr a}
- incr a
- }
- a
-} {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
OSDN Git Service
