Enhance catch and 'info returncodes'

*: Add optional arg to catch, opts, like Tcl 8.5 to allow access to the
   code given by 'return -code'
*: Use -- to signify end of options to catch
*: 'info returncodes' can give the name of a single code
*: Fix 'case' to handle 'return -code' properly

1 files changed, 9 insertions, 6 deletions

diff --git a/tests/case.test b/tests/case.test
index ce6075a..a74f265 100644
--- a/tests/case.test
+++ b/tests/case.test
@@ -6,8 +6,11 @@ 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"
+		set rc [catch [list uplevel 1 $code] error opts]
+		#puts "$code -> rc=$rc, error=$error, opts=$opts"
+		if {$rc == 2 && $opts(-code) != 0} {
+			set rc $opts(-code)
+		}
 		return -code $rc $error
 	}
 }
@@ -52,19 +55,19 @@ proc do_case {var} {
 			return one
 		}
 		2 {
-			return two
+			return -code ok two
 		}
 		3 {
-			continue
+			return -code continue three
 		}
 		4 {
 			return 44
 		}
 		5 {
-			break
+			return -code break five
 		}
 		6 {
-			return six
+			return eight
 		}
 	}
 	return zero