[AMG]: [try] and [throw] are very nice to have, but they are new to Tcl 8.6. Here are Tcl 8.5-compatible implementations that pass the 8.6.8 test suite: ====== proc try {args} { # Require at least one argument. if {![llength $args]} { throw {TCL WRONGARGS} "wrong # args: should be\ \"try body ?handler ...? ?finally script?\"" } # Scan arguments. set args [lassign $args body] set handlers {} while {[llength $args]} { set args [lassign $args type] switch $type { on { if {[llength $args] < 3} { throw {TCL OPERATION TRY ON ARGUMENT} "wrong # args to on\ clause: must be \"... on code variableList script\"" } set args [lassign $args code variableList script] if {![string is integer -strict $code]} { if {[regexp {^[ \f\n\r\t\v]*[-+]?\d+[ \f\n\r\t\v]*$} $code] || [set newCode [lsearch -exact\ {ok error return break continue} $code]] < 0} { throw {TCL RESULT ILLEGAL_CODE} "bad completion code\ \"$code\": must be ok, error, return, break,\ continue, or an integer" } set code $newCode } lappend handlers on $code $variableList $script } trap { if {[llength $args] < 3} { throw {TCL OPERATION TRY TRAP ARGUMENT} "wrong # args to\ trap clause: must be \"... trap pattern\ variableList script\"" } set args [lassign $args pattern variableList script] if {[catch {list {*}$pattern} pattern]} { throw {TCL OPERATION TRY TRAP EXNFORMAT} "bad prefix\ '$pattern': must be a list" } lappend handlers trap $pattern $variableList $script } finally { if {![llength $args]} { throw {TCL OPERATION TRY FINALLY ARGUMENT} "wrong # args\ to finally clause: must be \"... finally script\"" } set args [lassign $args finally] if {[llength $args]} { throw {TCL OPERATION TRY FINALLY NONTERMINAL} "finally\ clause must be last" } } default { throw [list TCL LOOKUP INDEX {handler type} $type] "bad handler\ type \"$type\": must be finally, on, or trap" }} } if {[info exists script] && $script eq "-"} { throw {TCL OPERATION TRY BADFALLTHROUGH} "last non-finally clause must\ not have a body of \"-\"" } # Evaluate the script body and intercept errors. set code [catch {uplevel 1 $body} result options] # Search for and evaluate the first matching handler. foreach {type pattern varList script} $handlers { if {![info exists next] && ($type ne "on" || $pattern != $code) && ($type ne "trap" || ![dict exists $options -errorcode] || $pattern ne [lrange [dict get $options -errorcode]\ 0 [expr {[llength $pattern] - 1}]])} { # Skip this handler if it doesn't match. } elseif {$script eq "-"} { # If the script is "-", evaluate the next handler script that is not # "-", regardless of the match criteria. set next {} } else { # Evaluate the handler script and intercept errors. if {[catch { if {[llength $varList] >= 1} { uplevel 1 [list set [lindex $varList 0] $result] } if {[llength $varList] >= 2} { uplevel 1 [list set [lindex $varList 1] $options] } uplevel 1 $script } result newOptions] && [dict exists $newOptions -errorcode]} { dict set newOptions -during $options } set options $newOptions # Stop after evaluating the first matching handler script. break } } # Evaluate the finally clause and intercept errors. if {[info exists finally] && [catch {uplevel 1 $finally} newResult newOptions]} { if {[dict exists $newOptions -errorcode]} { dict set newOptions -during $options } set options $newOptions set result $newResult } # Return any errors generated by the handler scripts. dict incr options -level return {*}$options $result } proc throw {type message} { if {![llength $type]} { return -code error -errorcode {TCL OPERATION THROW BADEXCEPTION}\ "type must be non-empty list" } else { return -code error -errorcode $type $message } } ====== <> Command | Control Structure