tclcompat: it is finally time to remove [case]

Use [switch] instead

Signed-off-by: Steve Bennett <steveb@workware.net.au>

2 files changed, 0 insertions, 127 deletions

diff --git a/tclcompat.tcl b/tclcompat.tcl
index b2e8139..84d9d25 100644
--- a/tclcompat.tcl
+++ b/tclcompat.tcl
@@ -56,47 +56,6 @@ if {[info commands stdout] ne ""} {
 	}
 }
 
-# case var ?in? pattern action ?pattern action ...?
-proc case {var args} {
-	# Skip dummy parameter
-	if {[lindex $args 0] eq "in"} {
-		set args [lrange $args 1 end]
-	}
-
-	# Check for single arg form
-	if {[llength $args] == 1} {
-		set args [lindex $args 0]
-	}
-
-	# Check for odd number of args
-	if {[llength $args] % 2 != 0} {
-		return -code error "extra case pattern with no body"
-	}
-
-	# Internal function to match a value agains a list of patterns
-	local proc case.checker {value pattern} {
-		string match $pattern $value
-	}
-
-	foreach {value action} $args {
-		if {$value eq "default"} {
-			set do_action $action
-			continue
-		} elseif {[lsearch -bool -command case.checker $value $var]} {
-			set do_action $action
-			break
-		}
-	}
-
-	if {[info exists do_action]} {
-		set rc [catch [list uplevel 1 $do_action] result opts]
-		if {$rc} {
-			incr opts(-level)
-		}
-		return {*}$opts $result
-	}
-}
-
 # fileevent isn't needed in Jim, but provide it for compatibility
 proc fileevent {args} {
 	tailcall {*}$args
diff --git a/tests/case.test b/tests/case.test
deleted file mode 100644
index ad35756..0000000
--- a/tests/case.test
+++ /dev/null
@@ -1,86 +0,0 @@
-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