Version 14 of try ... finally ...

Updated 2006-06-23 10:48:01 by jcw

PURPOSE: Demonstrate a Tcl implementation of a [try ... finally ...] construct.

Original post: KBK (8 November 2000)

Note: There is a TIP, including source code, to add "try...catch...finally" to the Tcl core, at: http://www.tcl.tk/cgi-bin/tct/tip/89

Note: the trycatch 2.0 package, available at http://www.wjduquette.com/tcl , includes a try ... finally ... construct, as well as other exception handling mechanisms. WHD (10 February 2001)


Often in programming, it is essential that some action be taken whenever control leaves a given region of code for whatever reason. For instance, a piece of code may be using some system resource and wish to free it when it terminates, whether normally or abnormally. Several languages other than Tcl provide this capability naturally; Common Lisp has it in the form of (unwind-protect), and Java has it as try ... finally ....

One of the beauties of Tcl is that it is possible for advanced users to add new control structures by judicious use of [uplevel]. The following code implements a Tcl version of [try ... finally ...].

A simple example of how to use it:

 set f [open [lindex $argv 0] r]
 try {
     set i 0
     while { [gets $f line] >= 0 } {
         incr i
         puts $line 
         if { [string equal $line BADSTUFF] } {
             error "bad stuff encountered in [lindex $argv 0], line $i"
         }
     }
 } finally {
     close $f
 }

 #----------------------------------------------------------------------
 #
 # try --
 #
 #       Execute a Tcl script with a mandatory cleanup.
 #
 # Usage:
 #       try script1 finally script2
 #
 # Parameters:
 #       script1 -- Script to execute
 #       finally -- The literal keyword, "finally".
 #       script2 -- Script to execute after script2
 #
 # Results:
 #       See below.
 #
 # Side effects:
 #       Whatever 'script1' and 'script2' do.
 #
 # The [try] command evaluates the script, 'script1'.  It saves the
 # result of evaluating the script temporarily, and then evaluates
 # 'script2'.  If 'script2' returns normally, the result of the
 # 'try' is the result of evaluating 'script1', which may be
 # a value, an error, or a return, continue, or break.  If 'script2'
 # returns an error, or if it breaks, continues, or returns, the
 # action of 'script2' overrides that of 'script1'; the result
 # of the [try] is to return the error, break, continue, or return.
 #
 # Bugs:
 #       [return -code] within either script cannot be implemented.
 #       For this reason, [try] should not be used around scripts
 #       that implement control structures.
 #
 # Example:
 #    The following script:
 #
 #       set f [open $fileName r]
 #       try {
 #            while { [gets $f line] >= 0 } {
 #                processOneLine $line
 #            }
 #       } finally {
 #            close $f
 #       }
 #
 #    has the effect of ensuring that the file is closed, irrespective
 #    of what processOneLine does.  (If [close] returns an error, that
 #    error is returned in preference to any error from the 'try'
 #    block.)
 #
 #----------------------------------------------------------------------

 proc try { script1 finally script2 } {
     if { [string compare $finally {finally}] } {
         append message 
             "syntax error: should be "" [lindex [info level 0] 0] 
             " script1 finally script2""
         return -code error $message
     }
     set status1 [catch {
         uplevel 1 $script1
     } result1]
     if { $status1 == 1 } {
         set info1 $::errorInfo
         set code1 $::errorCode
     }
     set status2 [catch {
         uplevel 1 $script2
     } result2]
     switch -exact -- $status2 {
         0 {                             # TCL_OK - 'finally' was ok
             switch -exact -- $status1 {
                 0 {                     # TCL_OK - 'try' was also ok
                     return $result1
                 }
                 1 {                     # TCL_ERROR - 'try' failed
                     return -code error 
                            -errorcode $code1 
                            -errorinfo $info1 
                            $result1 
                 }
                 2 {                     #  TCL_RETURN
                     return -code return $result1
                 }
                 3 {                     # TCL_BREAK
                     return -code break
                 }
                 4 {                     # TCL_CONTINUE
                     return -code continue
                 }
                 default {               # Another code
                     return -code $code $result1
                 }
             }
         }
         1 {                             # TCL_ERROR -- 'finally' failed
             set info2 $::errorInfo
             set code2 $::errorCode
             append info2 "
    ("finally" block)"
             return -code error -errorcode $code2 -errorinfo $info2 
                 $result2
         }
         2 {                             # TCL_RETURN
             # A 'return' in a 'finally' block overrides
             # any status from the 'try' ?

             return -code return $result2
         }
         3 {                             # TCL_BREAK
             # A 'break' in a 'finally' block overrides
             # any status from the 'try' ?

             return -code break
         }
         4 {                             # TCL_CONTINUE
             # A 'continue' in a 'finally' block overrides
             # any status from the 'try' ?

             return -code break
         }
         default {                       # Another code in 'finally'
             # Another code in a 'finally' block is returned
             # overriding any status from the 'try'

             return -code $code $result2
         }
     }
 }













Note that TclX has a [try_eval]. Also, TclExcept [L1 ] is a nice pure-Tcl package focused on exceptions, and mkGeneric [L2 ] implements rather Java-like exceptions. Combat also has a try, as do several other implementations written by various people.


Martin Lemburg wrote a try-catch-finally package 2 years ago, trying to implement the capabilities of the C++ try-catch-finally-construct. [L3 ] [L4 ] Man pages included, but not heavily tested. It works for my needs!


DKF Here's a version that leverages new features in Tcl 8.5:

 proc try {script args} {
    upvar 1 try___msg msg try___opts opts
    if {[llength $args]!=0 && [llength $args]!=2} {
       return -code error "wrong # args: should be "try script ?finally script?""
    }
    if {[llength $args] == 2} {
       if {[lindex $args 0] ne "finally"} {
          return -code error "mis-spelt "finally" keyword"
       }
    }
    set code [uplevel 1 [list catch $script try___msg try___opts]]
    if {[llength $args] == 2} {
       uplevel 1 [lindex $args 1]
    }
    if {$code} {
       dict incr opts -level 1
       return -options $opts $msg
    }
    return $msg
 }

TWAPI also includes a try-onerror-finally command.