1 files changed, 80 insertions, 0 deletions
diff --git a/tests/case.test b/tests/case.test
new file mode 100644
index 0000000..1973477
--- /dev/null
+++ b/tests/case.test
@@ -0,0 +1,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 {
+			return 33
+		}
+		4 {
+			continue
+		}
+		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 33}
+