with_finally (public, deprecated)

 with_finally -code code -finally finally

Defined in packages/acs-tcl/tcl/deprecated-procs.tcl

Deprecated. Invoking this procedure generates a warning.

Execute CODE, then execute cleanup code FINALLY. If CODE completes normally, its value is returned after executing FINALLY. If CODE exits non-locally (as with error or return), FINALLY is executed anyway.

Switches:

-code (required)

Code to be executed that could throw and error

-finally (required)

Cleanup code to be executed even if an error occurs DEPRECATED: does not comply with OpenACS naming convention and can be replaced with better api such as ad_try or native Tcl constructs such as ::try (8.6)

See Also:

• try
• ad_try

Testcases:

No testcase defined.

Source code:

ad_log_deprecated proc with_finally

    # Execute CODE.
    set return_code [catch {uplevel $code} string]

    if {[info exists ::errorInfo]} {
        set s_errorInfo $::errorInfo
    } else {
        set s_errorInfo ""
    }
    if {[info exists ::errorCode]} {
        set s_errorCode $::errorCode
    } else {
        set s_errorCode ""
    }

    # As promised, always execute FINALLY.  If FINALLY throws an
    # error, Tcl will propagate it the usual way.  If FINALLY contains
    # stuff like break or continue, the result is undefined.
    uplevel $finally

    switch -- $return_code {
        0 {
            # CODE executed without a non-local exit -- return what it
            # evaluated to.
            return $string
        }
        1 {
            # Error
            if {[lindex $s_errorCode 0 0] eq "CHILDSTATUS"} {
                #
                # GN: In case the errorCode starts with CHILDSTATUS it
                # means that an error was raised from an "exec". In
                # that case the raw error just tells that the "child
                # process exited abnormally", without given any
                # details. Therefore, we add the exit code to the
                # messages.
                #
                set extra "child process (pid [lindex $s_errorCode 0 1]) exited with exit-code [lindex $s_errorCode 0 end]"
                append string " ($extra)"
                set s_errorInfo $extra\n$s_errorInfo
            }
            return -code error -errorinfo $s_errorInfo -errorcode $s_errorCode $string
        }
        2 {
            # Return from the caller.
            return -code return $string
        }
        3 {
            # break
            return -code break
        }
        4 {
            # continue
            return -code continue
        }
        default {
            return -code $return_code $string
        }
    }

XQL Not present:

PostgreSQL, Oracle

Generic XQL file:

packages/acs-tcl/tcl/deprecated-procs.xql