1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
source [file dirname [info script]]/testing.tcl
needs cmd case {tclcompat}
catch {unset result}
test case-1.1 "Simple case" {
foreach c {abc xyz def sdfbc basdf a aba} {
case $c in {
b* {
lappend result 1
}
{ab a} {
lappend result 2
}
{def *bc} {
lappend result 3
}
default {
lappend result 4
}
}
}
set result
} {3 4 3 3 1 2 4}
# case is a proc, but it should be able
# to cause a return in do_case
proc do_case {var} {
case $var in {
0 {
return
}
1 {
return one
}
2 {
return -code ok two
}
3 {
return -code continue three
}
4 {
return -code break four
}
5 {
continue
}
6 {
break
}
}
return zero
}
test case-2.0 "Plain from case" {
do_case 0
} {}
test case-2.1 "Return from case with value" {
do_case 1
} {one}
test case-2.2 "Return -code ok from case" {
do_case 2
list [catch {do_case 2} msg] $msg
} {0 two}
test case-2.3 "Return -code continue from case" {
list [catch {do_case 3} msg] $msg
} {4 three}
test case-2.4 "Return -code break from case" {
list [catch {do_case 4} msg] $msg
} {3 four}
if {0} {
test case-2.5 "continue from case" {
list [catch {do_case 5} msg] $msg
} {1 {invoked "continue" outside of a loop}}
test case-2.6 "break from case" {
list [catch {do_case 6} msg] $msg
} {1 {invoked "break" outside of a loop}}
}
testreport
|
