aboutsummaryrefslogtreecommitdiff
path: root/tests/case.test
blob: ce6075a6f4a0ab08738e334d8e91ac6e6651dac0 (plain)
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
source testing.tcl

# Test that control structures can be implemented in a proc

proc control {cond code} {
	set iscond [uplevel 1 expr $cond]
	#puts "$cond -> $iscond"
	if {$iscond} {
		set rc [catch [list uplevel 1 $code] error]
		#puts "$code -> rc=$rc, error=$error"
		return -code $rc $error
	}
}

test control-1.1 "False case" {
	control 0 bogus
} {}

test control-1.2 "Simple case" {
	control 1 {return result}
} {result}

test control-1.3 "Break from proc" {
	set result {}
	foreach i {1 2 3 4 5} {
		control {$i == 4} {break}
		lappend result $i
	}
	set result
} {1 2 3}

test control-1.4 "Return from proc" {
	foreach i {1 2 3 4 5} {
		control {$i == 3} {return $i}
	}
} {3}

test control-1.5 "Continue from proc" {
	set result {}
	foreach i {1 2 3 4 5} {
		control {$i == 2} {continue}
		lappend result $i
	}
	set result
} {1 3 4 5}

# case is a proc, but it should be able
# to cause a return in do_case
proc do_case {var} {
	case $var in {
		1 {
			return one
		}
		2 {
			return two
		}
		3 {
			continue
		}
		4 {
			return 44
		}
		5 {
			break
		}
		6 {
			return six
		}
	}
	return zero
}

test control-2.1 "Return from case" {
	set result {}
	foreach i {0 1 2 3 4 5 6} {
		lappend result [do_case $i]
	}
	set result
} {zero one two 44}