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