From 74318119b04effffec948581aa1004b23fdd6c3b Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 16 Dec 2008 22:07:58 +0000
Subject: Added tests for [throw] and [try].

---
 ChangeLog        |   1 +
 tests/error.test | 604 +++++++++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 564 insertions(+), 41 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 278d95d..3f999a4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,7 @@
 
 	TIP #329 IMPLEMENTATION
 
+	* tests/error.test: Tests for the new commands.
 	* doc/throw.n, doc/try.n: Documentation of the new commands.
 	* library/init.tcl (throw, try): Implementation of commands documented
 	in TIP. This implementation is in Tcl and is a stop-gap until
diff --git a/tests/error.test b/tests/error.test
index 67c87b4..dfb466f 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -1,17 +1,17 @@
-# Commands covered:  error, catch
+# Commands covered:  error, catch, throw, try
 #
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: error.test,v 1.16 2006/10/09 19:15:44 msofer Exp $
+# RCS: @(#) $Id: error.test,v 1.17 2008/12/16 22:07:58 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -19,6 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 }
 
 namespace eval ::tcl::test::error {
+
 proc foo {} {
     global errorInfo
     set a [catch {format [error glorp2]} b]
@@ -36,66 +37,55 @@ proc foo2 {} {
 test error-1.1 {simple errors from commands} {
     catch {format [string index]} b
 } 1
-
 test error-1.2 {simple errors from commands} {
     catch {format [string index]} b
     set b
 } {wrong # args: should be "string index string charIndex"}
-
 test error-1.3 {simple errors from commands} {
     catch {format [string index]} b
     set ::errorInfo
-    # this used to return '... while executing ...', but
-    # string index is fully compiled as of 8.4a3
+    # This used to return '... while executing ...', but string index is fully
+    # compiled as of 8.4a3
 } {wrong # args: should be "string index string charIndex"
     while executing
 "string index"}
-
 test error-1.4 {simple errors from commands} {
     catch {error glorp} b
 } 1
-
 test error-1.5 {simple errors from commands} {
     catch {error glorp} b
     set b
 } glorp
-
 test error-1.6 {simple errors from commands} {
     catch {catch a b c d} b
 } 1
-
 test error-1.7 {simple errors from commands} {
     catch {catch a b c d} b
     set b
 } {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
-
 test error-1.8 {simple errors from commands} {
-    # This test is non-portable: it generates a memory fault on
-    # machines like DEC Alphas (infinite recursion overflows
-    # stack?)
+    # This test is non-portable: it generates a memory fault on machines like
+    # DEC Alphas (infinite recursion overflows stack?)
     #
     # That claims sounds like a bug to be fixed rather than a portability
-    # problem.  Anyhow, I believe it's out of date (bug's been fixed) so
-    # this test is re-enabled.
-
+    # problem. Anyhow, I believe it's out of date (bug's been fixed) so this
+    # test is re-enabled.
     proc p {} {
         uplevel 1 catch p error
     }
     p
 } 0
 
-# Check errors nested in procedures.  Also check the optional argument
-# to "error" to generate a new error trace.
+# Check errors nested in procedures. Also check the optional argument to
+# "error" to generate a new error trace.
 
 test error-2.1 {errors in nested procedures} {
     catch foo b
 } 1
-
 test error-2.2 {errors in nested procedures} {
     catch foo b
     set b
 } {Human-generated}
-
 test error-2.3 {errors in nested procedures} {
     catch foo b
     set ::errorInfo
@@ -105,16 +95,13 @@ test error-2.3 {errors in nested procedures} {
     (procedure "foo" line 4)
     invoked from within
 "foo"}
-
 test error-2.4 {errors in nested procedures} {
     catch foo2 b
 } 1
-
 test error-2.5 {errors in nested procedures} {
     catch foo2 b
     set b
 } {Human-generated}
-
 test error-2.6 {errors in nested procedures} {
     catch foo2 b
     set ::errorInfo
@@ -221,21 +208,552 @@ test error-6.9 {catch must reset error state} {
     list $::errorCode
 } {NONE}
 
-    test error-7.0 {Bug 1397843} -body {
+test error-7.1 {Bug 1397843} -body {
+    variable cmds
+    proc EIWrite args {
 	variable cmds
-	proc EIWrite args {
-	    variable cmds
-	    lappend cmds [lindex [info level -2] 0]
+	lappend cmds [lindex [info level -2] 0]
+    }
+    proc BadProc {} {
+	set i a
+	incr i
+    }
+    trace add variable ::errorInfo write [namespace code EIWrite]
+    catch BadProc
+    trace remove variable ::errorInfo write [namespace code EIWrite]
+    set cmds
+} -match glob -result {*BadProc*}
+
+# throw tests
+
+test error-8.1 {throw produces error 1 at level 0} {
+    catch { throw FOO bar }
+} {1}
+test error-8.2 {throw behaves as error does at level 0} {
+    catch { throw FOO bar } em1 opts1
+    catch { error bar {} FOO } em2 opts2
+    dict set opts1 -result $em1
+    dict set opts2 -result $em2
+    foreach key {-code -level -result -errorcode} {
+	if { [dict get $opts1 $key] ne [dict get $opts2 $key] } {
+	    error "error/throw outcome differs on '$key'"
+	}
+    }
+} {}
+test error-8.3 {throw produces error 1 at level > 0} {
+    proc throw_foo {} {
+	throw FOO bar
+    }
+    catch { throw_foo }
+} {1}
+test error-8.4 {throw behaves as error does at level > 0} {
+    proc throw_foo {} {
+	throw FOO bar
+    }
+    proc error_foo {} {
+	error bar {} FOO
+    }
+    catch { throw_foo } em1 opts1
+    catch { error_foo } em2 opts2
+    dict set opts1 -result $em1
+    dict set opts2 -result $em2
+    foreach key {-code -level -result -errorcode} {
+	if { [dict get $opts1 $key] ne [dict get $opts2 $key] } {
+	    error "error/throw outcome differs on '$key'"
+	}
+    }
+} {}
+
+# simple try tests: body completes with code ok
+
+test error-9.1 {try (ok, empty result) with no handlers} {
+    try list
+} {}
+test error-9.2 {try (ok, non-empty result) with no handlers} {
+    try { list a b c }
+} {a b c}
+test error-9.3 {try (ok, non-empty result) with trap handler} {
+    try { list a b c } trap {} {} { list d e f }
+} {a b c}
+test error-9.4 {try (ok, non-empty result) with on handler} {
+    try { list a b c } on break {} { list d e f }
+} {a b c}
+test error-9.5 {try (ok, non-empty result) with on ok handler} {
+    try { list a b c } on ok {} { list d e f }
+} {d e f}
+
+# simple try tests - "on" handler matching
+
+test error-10.1 {try with on ok} {
+    try { list a b c } on ok {} { list d e f }
+} {d e f}
+test error-10.2 {try with on 0} {
+    try { list a b c } on 0 {} { list d e f }
+} {d e f}
+test error-10.3 {try with on error (using error)} {
+    try { error a b c } on error {} { list d e f }
+} {d e f}
+test error-10.4 {try with on error (using return -code)} {
+    try { return -level 0 -code 1 a } on error {} { list d e f }
+} {d e f}
+test error-10.5 {try with on error (using throw)} {
+    try { throw c a } on error {} { list d e f }
+} {d e f}
+test error-10.6 {try with on 1 (using error)} {
+    try { error a b c } on 1 {} { list d e f }
+} {d e f}
+test error-10.7 {try with on return} {
+    try { return [list a b c] } on return {} { list d e f }
+} {d e f}
+test error-10.8 {try with on break} {
+    try { break } on break {} { list d e f }
+} {d e f}
+test error-10.9 {try with on continue} {
+    try { continue } on continue {} { list d e f }
+} {d e f}
+test error-10.10 {try with on for arbitrary (decimal) return code} {
+    try { return -level 0 -code 123456 } on 123456 {} { list d e f }
+} {d e f}
+test error-10.11 {try with on for arbitrary (hex) return code} {
+    try { return -level 0 -code 0x123456 } on 0x123456 {} { list d e f }
+} {d e f}
+test error-10.12 {try with on for arbitrary return code (mixed number representations)} {
+    try { return -level 0 -code 0x10 } on 16 {} { list d e f }
+} {d e f}
+
+# simple try tests - "trap" handler matching
+
+test error-11.1 {try with trap all} {
+    try { throw FOO bar  } trap {} {} { list d e f }
+} {d e f}
+test error-11.2 {try with trap (exact)} {
+    try { throw FOO bar  } trap {FOO} {} { list d e f }
+} {d e f}
+test error-11.3 {try with trap (prefix 1)} {
+    try { throw [list FOO A B C D] bar  } trap {FOO} {} { list d e f }
+} {d e f}
+test error-11.4 {try with trap (prefix 2)} {
+    try { throw [list FOO A B C D] bar  } trap {FOO A} {} { list d e f }
+} {d e f}
+test error-11.5 {try with trap (prefix 3)} {
+    try { throw [list FOO A B C D] bar  } trap {FOO A B} {} { list d e f }
+} {d e f}
+test error-11.6 {try with trap (prefix 4)} {
+    try { throw [list FOO A B C D] bar  } trap {FOO A B C} {} { list d e f }
+} {d e f}
+test error-11.7 {try with trap (exact, 5 elements)} {
+    try { throw [list FOO A B C D] bar  } trap {FOO A B C D} {} { list d e f }
+} {d e f}
+
+# simple try tests - variable assignment and result handling
+
+test error-12.1 {try with no variable assignment in on handler} {
+    try { throw FOO bar } on error {} { list d e f }
+} {d e f}
+test error-12.2 {try with result variable assignment in on handler} {
+    try { throw FOO bar } on error {res} { set res }
+} {bar}
+test error-12.3 {try with result variable assignment in on handler, var remains in scope} {
+    try { throw FOO bar } on error {res} { list d e f }
+    set res
+} {bar}
+test error-12.4 {try with result/opts variable assignment in on handler} {
+    try {
+	throw FOO bar
+    } on error {res opts} {
+	set r "$res,[dict get $opts -errorcode]"
+    }
+} {bar,FOO}
+test error-12.5 {try with result/opts variable assignment in on handler, vars remain in scope} {
+    try { throw FOO bar } on error {res opts} { list d e f }
+    set r "$res,[dict get $opts -errorcode]"  
+} {bar,FOO}
+test error-12.6 {try result is propagated if no matching handler} {
+    try { list a b c } on error {} { list d e f }
+} {a b c}
+test error-12.7 {handler result is propagated if handler executes} {
+    try { throw FOO bar } on error {} { list d e f }
+} {d e f}
+
+# negative case try tests - bad args to try
+
+test error-13.1 {try with no arguments} -body {
+    # warning: error message may change
+    try
+} -returnCodes error -match glob -result {wrong # args: *}
+test error-13.2 {try with body only (ok) } {
+    try list
+} {}
+test error-13.3 {try with missing finally body } -body {
+    # warning: error message may change
+    try list finally
+} -returnCodes error -match glob -result {wrong # args: *}
+test error-13.4 {try with bad handler keyword } -body {
+    # warning: error message may change
+    try list then a b c
+} -returnCodes error -match glob -result {bad handler *}
+test error-13.5 {try with partial handler #1 } -body {
+    # warning: error message may change
+    try list on
+} -returnCodes error -match glob -result {bad code *}
+test error-13.6 {try with partial handler #2 } -body {
+    # warning: error message may change
+    try list on error
+} -returnCodes error -match glob -result {wrong # args: *}
+test error-13.7 {try with partial handler #3 } -body {
+    # warning: error message may change
+    try list on error {em opts}
+} -returnCodes error -match glob -result {wrong # args: *}
+test error-13.8 {try with multiple handlers and finally (ok)} {
+    try list on error {} {} trap {} {} {} finally {}
+} {}
+test error-13.9 {last handler body can't be a fallthrough #1} -body {
+    try list on error {} {} on break {} - 
+} -returnCodes error -match glob -result {wrong # args: *}
+test error-13.10 {last handler body can't be a fallthrough #2} -body {
+    try list on error {} {} on break {} - finally { list d e f }
+} -returnCodes error -match glob -result {wrong # args: *}
+
+# try tests - multiple handlers (left-to-right matching, only one runs)
+
+test error-14.1 {try with multiple handlers (only one matches) #1} {
+    try { throw FOO bar } on ok {} { list a b c } trap FOO {} { list d e f }
+} {d e f}
+test error-14.2 {try with multiple handlers (only one matches) #2} {
+    try { throw FOO bar } trap FOO {} { list d e f } on ok {} { list a b c } 
+} {d e f}
+test error-14.3 {try with multiple handlers (only one matches) #3} {
+    try {
+	throw FOO bar
+    } on break {} {
+	list x y z
+    } trap FOO {} {
+	list d e f
+    } on ok {} {
+	list a b c
+    } 
+} {d e f}
+test error-14.4 {try with multiple matching handlers (only the first in left-to-right order runs) #1} {
+    try { throw FOO bar } on error {} { list a b c } trap FOO {} { list d e f }
+} {a b c}
+test error-14.5 {try with multiple matching handlers (only the first in left-to-right order runs) #2} {
+    try { throw FOO bar } trap FOO {} { list d e f } on error {} { list a b c }
+} {d e f}
+test error-14.6 {try with multiple matching handlers (only the first in left-to-right order runs) #3} {
+    try { throw FOO bar } trap {} {} { list d e f } on 1 {} { list a b c }
+} {d e f}
+test error-14.7 {try with multiple matching handlers (only the first in left-to-right order runs) #4} {
+    try { throw FOO bar } on 1 {} { list a b c } trap {} {} { list d e f }
+} {a b c}
+test error-14.8 {try with handler-of-last-resort "trap {}"} {
+    try { throw FOO bar } trap FOX {} { list a b c } trap {} {} { list d e f }
+} {d e f}
+test error-14.9 {try with handler-of-last-resort "on error"} {
+    try { foo } trap FOX {} { list a b c } on error {} { list d e f }
+} {d e f}
+
+# try tests - propagation (no matching handlers)
+
+test error-15.1 {try with no handler (ok result propagates)} {
+    try { list a b c }
+} {a b c}
+test error-15.2 {try with no matching handler (ok result propagates)} {
+    try { list a b c } on error {} { list d e f }
+} {a b c}
+test error-15.3 {try with no handler (error result propagates)} -body {
+    try { throw FOO bar }
+} -returnCodes error -result {bar}
+test error-15.4 {try with no matching handler (error result propagates)} -body {
+    try { throw FOO bar } trap FOX {} { list a b c }
+} -returnCodes error -result {bar}
+test error-15.5 {try with no handler (return result propagates)} -body {
+    try { return bar }
+} -returnCodes 2 -result {bar}
+test error-15.6 {try with no matching handler (break result propagates)} -body {
+    try { if {1} break } on error {} { list a b c }
+} -returnCodes 3 -result {}
+test error-15.7 {try with no matching handler (unknown integer result propagates)} -body {
+    try { return -level 0 -code 123456 } trap {} {} { list a b c }
+} -returnCodes 123456 -result {}
+
+# try tests - propagation (exceptions in handlers, exception chaining)
+
+test error-16.1 {try with successfully executed handler} {
+    try { throw FOO bar } trap FOO {} { list a b c }
+} {a b c}
+test error-16.2 {try with exception (error) in handler} -body {
+    try { throw FOO bar } trap FOO {} { throw BAR foo }
+} -returnCodes error -result {foo}
+test error-16.3 {try with exception (return) in handler} -body {
+    try { throw FOO bar } trap FOO {} { return BAR }
+} -returnCodes 2 -result {BAR}
+test error-16.4 {try with exception (break) in handler #1} -body {
+    try { throw FOO bar } trap FOO {} { break }
+} -returnCodes 3 -result {}
+test error-16.5 {try with exception (break) in handler #2} {
+    for { set i 5 } { $i < 10 } { incr i } {
+	try { throw FOO bar } trap FOO {} { break }
+    }
+    set i
+} {5}
+test error-16.6 {try with variable assignment and propagation #1} {
+    # Ensure that the handler variables preserve the exception off the
+    # try-body, and are not modified by the exception off the handler
+    catch {
+	try { throw FOO bar } trap FOO {em} { throw BAR baz }
+    }
+    set em  
+} {bar}
+test error-16.7 {try with variable assignment and propagation #2} {
+    catch {
+	try { throw FOO bar } trap FOO {em opts} { throw BAR baz }
+    }
+    list $em [dict get $opts -errorcode]  
+} {bar FOO}
+test error-16.8 {exception chaining (try=ok, handler=error)} {
+    #FIXME is the intent of this test correct?  
+    catch {
+	try { list a b c } on ok {em opts} { throw BAR baz }
+    } tryem tryopts
+    string equal $opts [dict get $tryopts -during]
+} {1}
+test error-16.9 {exception chaining (try=error, handler=error)} {
+    # The exception off the handler should chain to the exception off the
+    # try-body (using the -during option)
+    catch {
+	try { throw FOO bar } trap {} {em opts} { throw BAR baz }
+    } tryem tryopts
+    string equal $opts [dict get $tryopts -during]
+} {1}
+test error-16.10 {no exception chaining when handler is successful} {
+    catch {
+	try { throw FOO bar } trap {} {em opts} { list d e f }
+    } tryem tryopts
+    dict exists $tryopts -during
+} {0}
+test error-16.11 {no exception chaining when handler is a non-error exception} {
+    catch {
+	try { throw FOO bar } trap {} {em opts} { break }
+    } tryem tryopts
+    dict exists $tryopts -during
+} {0}
+
+# try tests - finally
+
+test error-17.1 {finally always runs (try with ok result)} {
+    set RES {}
+    try { list a b c } finally { set RES done }
+    set RES
+} {done}
+test error-17.2 {finally always runs (try with error result)} {
+    set RES {}
+    catch {
+	try { throw FOO bar } finally { set RES done }
+    }
+    set RES
+} {done}
+test error-17.3 {finally always runs (try with matching handler)} {
+    set RES {}
+    try { throw FOO bar } trap FOO {} { list a b c } finally { set RES done }
+    set RES
+} {done}
+test error-17.4 {finally always runs (try with exception in handler)} {
+    set RES {}
+    catch {
+	try {
+	    throw FOO bar
+	} trap FOO {} {
+	    throw BAR baz
+	} finally {
+	    set RES done
 	}
-	proc BadProc {} {
-	    set i a
-	    incr i
+    }
+    set RES
+} {done}
+test error-17.5 {successful finally doesn't modify try outcome (try=ok)} {
+    try { list a b c } finally { list d e f }
+} {a b c}
+test error-17.6 {successful finally doesn't modify try outcome (try=return)} -body {
+    try { return c } finally { list d e f }
+} -returnCodes 2 -result {c}
+test error-17.7 {successful finally doesn't modify try outcome (try=error)} -body {
+    try { error bar } finally { list d e f }
+} -returnCodes 1 -result {bar}
+test error-17.8 {successful finally doesn't modify handler outcome (handler=ok)} {
+    try { throw FOO bar } trap FOO {} { list a b c } finally { list d e f }
+} {a b c}
+test error-17.9 {successful finally doesn't modify handler outcome (handler=error)} -body {
+    try { throw FOO bar } trap FOO {} { throw BAR baz } finally { list d e f }
+} -returnCodes error -result {baz}
+test error-17.10 {successful finally doesn't affect variable assignment} {
+    catch {
+	try { throw FOO bar } trap FOO {em opts} { list d e f } finally { list d e f }
+    } result
+    list $em $result
+} {bar {d e f}}
+test error-17.11 {successful finally doesn't affect variable assignment or propagation} {
+    catch {
+	try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { list d e f }
+    }
+    list $em [dict get $opts -errorcode]  
+} {bar FOO}
+
+# try tests - propagation (exceptions in finally, exception chaining)
+
+test error-18.1 {try (ok) with exception in finally (error)} -body {
+    try { list a b c } finally { throw BAR foo }
+} -returnCodes error -result {foo}
+test error-18.2 {try (error) with exception in finally (break)} -body {
+    try { throw FOO bar } finally { break }
+} -returnCodes 3 -result {}
+test error-18.3 {try (ok) with handler (ok) and exception in finally (error)} -body {
+    try { list a b c } on ok {} { list d e f } finally { throw BAR foo }
+} -returnCodes error -result {foo}
+test error-18.4 {try (error) with exception in handler (error) and in finally (arb code)} -body {
+    try { throw FOO bar } on error {} { throw BAR baz } finally { return -level 0 -code 99 zing }
+} -returnCodes 99 -result {zing}
+test error-18.5 {exception in finally doesn't affect variable assignment} {
+    catch {
+	try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { throw BAZ zing }
+    }
+    list $em [dict get $opts -errorcode]  
+} {bar FOO}
+test error-18.6 {exception chaining in finally (try=ok)} {
+    catch {
+	list a b c 
+    } em expopts
+    catch {
+	try { list a b c } finally { throw BAR foo }
+    } em opts
+    string equal $expopts [dict get $opts -during]
+} {1}
+test error-18.7 {exception chaining in finally (try=error)} {
+    catch {
+	try { throw FOO bar } finally { throw BAR baz }
+    } em opts
+    dict get $opts -during -errorcode
+} {FOO}
+test error-18.8 {exception chaining in finally (try=ok, handler=ok)} {
+    catch {
+	try { list a b c } on ok {} { list d e f } finally { throw BAR baz }
+    } em opts
+    list [dict get $opts -during -code] [dict exists $opts -during -during]
+} {0 0}
+test error-18.9 {exception chaining in finally (try=error, handler=ok)} {
+    catch {
+	try {
+	    throw FOO bar
+	} on error {} {
+	    list d e f
+	} finally {
+	    throw BAR baz
+	}
+    } em opts
+    list [dict get $opts -during -code] [dict exists $opts -during -during]
+} {0 0}
+test error-18.10 {exception chaining in finally (try=error, handler=error)} {
+    catch {
+	try {
+	    throw FOO bar
+	} on error {} {
+	    throw BAR baz
+	} finally {
+	    throw BAR baz
 	}
-	trace add variable ::errorInfo write [namespace code EIWrite]
-	catch BadProc
-	trace remove variable ::errorInfo write [namespace code EIWrite]
-	set cmds
-    } -match glob -result {*BadProc*}
+    } em opts
+    list [dict get $opts -during -errorcode] [dict get $opts -during -during -errorcode]
+} {BAR FOO}
+test error-18.11 {no exception chaining if finally produces a non-error exception} {
+    catch {
+	try { throw FOO bar } on error {} { throw BAR baz } finally { break }
+    } em opts
+    dict exists $opts -during
+} {0}
+test error-18.12 {variable assignment unaffected by exception in finally} {
+    catch {
+	try {
+	    throw FOO bar
+	} on error {em opts} {
+	    list a b c
+	} finally {
+	    throw BAR baz
+	}
+    }
+    list $em [dict get $opts -errorcode]
+} {bar FOO}
+
+# try tests - fallthough body cases
+
+test error-19.1 {try with fallthrough body #1} {
+    set RES {}
+    try { list a b c } on ok { set RES 0 } - on error {} { set RES 1 }
+    set RES
+} {1}
+test error-19.2 {try with fallthrough body #2} {
+    set RES {}
+    try { 
+	throw FOO bar 
+    } trap BAR {} {
+    } trap FOO {} - trap {} {} {
+	set RES foo
+    } on error {} {
+	set RES err
+    }  
+    set RES
+} {foo}
+test error-19.3 {try with cascade fallthrough} {
+    set RES {}
+    try {
+	throw FOO bar
+    } trap FOO {} - trap BAR {} - trap {} {} {
+	set RES trap
+    } on error {} { set RES err }
+    set RES
+} {trap}
+test error-19.4 {multiple unrelated fallthroughs #1} {
+    set RES {}
+    try {
+	throw FOO bar
+    } trap FOO {} - trap BAR {} { 
+	set RES foo
+    } trap {} {} - on error {} {
+	set RES err
+    } 
+    set RES
+} {foo}
+test error-19.5 {multiple unrelated fallthroughs #2} {
+    set RES {}
+    try {
+	throw BAZ zing
+    } trap FOO {} - trap BAR {} { 
+	set RES foo
+    } trap {} {} - on error {} {
+	set RES err
+    } 
+    set RES
+} {err}
+
+# FIXME test what vars get set on fallthough ... what is the correct behavior?
+# It would seem appropriate to set at least those for the matching handler and
+# the executed body; possibly for each handler we fall through as well?
+
+# negative case try tests - bad "on" handler
+
+test error-20.1 {bad code name in on handler} -body {
+    try { list a b c } on foo {} {}
+} -returnCodes error -match glob -result {bad code *}
+test error-20.2 {bad code value in on handler} -body {
+    try { list a b c } on 34985723094872345 {} {}
+} -returnCodes error -match glob -result {bad code *}
+
+# negative case try tests - bad "trap" handler
+# what is the effect if we attempt to trap an errorcode that is not a list?
+# nested try
+# catch inside try
+# no tests for bad varslist?
+# -errorcode but code!=1 doesn't trap
+# throw negative case tests (no args, too many args, etc)
+
 }
 namespace delete ::tcl::test::error
 
@@ -243,3 +761,7 @@ namespace delete ::tcl::test::error
 catch {rename p ""}
 ::tcltest::cleanupTests
 return 
+
+# Local Variables:
+# mode: tcl
+# End:
-- 
cgit v0.12