\documentclass[]{article}
\usepackage{amsmath,graphicx,supertabular,hyperref,tabularx,ifthen}
\title{TIP \#89: Try/Catch Exception Handling in the Core}
\date{March 11, 2002}
\author{Tom Wilkason, Frank Pilhofer}
\urlstyle{sf}
\setlength{\parskip}{1ex}
\setlength{\parindent}{0pt}
\def\tipversion$#1${\texttt{\$#1\$}}
\def\tiplangle#1{\ensuremath{<}}
\def\tiprangle#1{\ensuremath{>}}
\def\tipbar#1{\ensuremath{|}}
\def\tipmail#1#2{\(\langle\){\small\expandafter\url{#1@#2}}\(\rangle\)}
\ifx\pdfoutput\undefined
\newcommand{\tipimage}[2]{\typeout{Make sure you download #1.eps}\ifthenelse{\lengthtest{0.8\textwidth>#2}\and\lengthtest{0pt<#2}}{\includegraphics{#1.eps}}{\includegraphics[width=0.8\textwidth]{#1.eps}}}
\newcommand{\tipxref}[1]{}
\newcommand{\tipxrefend}{}
\else
\newcommand{\tipimage}[2]{\typeout{Make sure you create #1.pdf}\ifthenelse{\lengthtest{0.8\textwidth>#2}\and\lengthtest{0pt<#2}}{\includegraphics{#1.pdf}}{\includegraphics[width=0.8\textwidth]{#1.pdf}}}
\pdfcatalog{/PageMode /UseOutlines}
\newcommand{\tipxref}[1]{\pdfannotlink attr {/C [0.5 0.5 1.0] /Border [0 0 1]} goto name {#1}}
\newcommand{\tipxrefend}{\pdfendlink}
\fi
\newenvironment{tipabstract}{\begin{abstract}}{\end{abstract}}
\begin{document}\maketitle
\begin{center}\begin{tabularx}{\linewidth}{|r@{: }X|}\hline
\textbf{TIP \#89}&\textbf{Try/Catch Exception Handling in the Core}\\\hline
Author&

Tom Wilkason \tipmail{tom.wilkason}{cox.net}
\par
Frank Pilhofer \tipmail{520065607613-0001}{t-online.de}
\\
Created&Monday, \(\text{11}^{\text{th}}\) March 2002\\
Type&Project\\
Tcl Version&\(8.6\)\\
State&Withdrawn\\
Vote&Pending\\
Version&\tipversion$Revision: 1.10 $\\
Obsoleted By&329\\
Post History&\\
Discussions To&news:comp.lang.tcl\\
\hline\end{tabularx}\end{center}
\thispagestyle{empty}\pagestyle{empty}
\begin{tipabstract}

This TIP proposes the addition of a \textbf{try}...\textbf{catch}...\textbf{finally} command to provide a more robust and powerful exception handling mechanism.
\end{tipabstract}
\tableofcontents\setcounter{page}{0}\clearpage\pagestyle{plain}

\section{Rationale}

Exceptions are currently supported very well in Tcl, in fact they are a major advantage over many other languages. However the mechanism to \textbf{catch} and handle the errors is someone limited and does not promote the full use of existing error codes. Wrapper procedures can be written to improve on this, however both a performance and compatibility penalty is incurred.

This TIP proposes adding a \textbf{try/catch} command to the Tcl core (or C based Tcl library). This implementation is not unlike those found in C++, C\#, Java and Python (to name a few languages).

An argument to add this to the core is that it modernizes the Tcl exception handling without impacting performance in any other way. \textbf{try/catch} are isolated commands that can easily be added, and do not interact with other commands or require other changes. \textbf{try/catch} is not an isolated extension that is useful for special purposes only. These commands, if implemented into the core, will be useful for any script currently using the catch construct.

\section{Specification}

I propose the following two commands be added to Tcl:
\begin{itemize}
\item{}
\textbf{throw} command.

\textbf{throw} ?\textit{type}? ?\textit{message}? ?\textit{info}?

A \textbf{throw} command with \textit{type} throws an error exception with the errorCode \textit{type}. The \textbf{throw} command works as the \textbf{error} command, but the arguments are reordered to encourage the use of error-codes. The optional \textit{message} and \textit{info} parameters work as they do in the \textbf{error} command.

The throw \textit{type} can be any user defined or built in type, built-in types include POSIX, ARITH, CORE, REGEXP, WINDOWS, NONE, ... The \textit{message} is optional, and is the same as that issued by the \textbf{catch} command, \textbf{error -code error} ``\textit{message}''

An instance of \textbf{throw} with no arguments can be used within a \textbf{catch} block to immediately re-throw the current exception that is being handled by the \textbf{catch} block. When an error is re-thrown in the catch block, the current error is propagated up one level following the evaluation of the \textbf{finally} block (if on exists). Enclosing error handlers can then deal with the error.

Note that
\begingroup\small\begin{verbatim}
    throw type message info
\end{verbatim}
\endgroup

is the same as
\begingroup\small\begin{verbatim}
    error message info type
\end{verbatim}
\endgroup
\item{}
\textbf{try} command.

\textbf{try} \textit{body} ?\textbf{catch} \{\{\textit{type\_list}\} ?\textit{ecvar}? ?\textit{msgvar}? ?\textit{infovar}?\} \textit{body ...}? ?\textbf{finally} \textit{body}?

If one or more \textbf{catch} blocks are specified, each corresponding \textit{body} represents a required block of code that is evaluated if the resulting errorCode matches the \textit{type} condition. The required body of the \textbf{finally} block is evaluated following the \textbf{try} block and \textbf{catch} block (if any matches).

\textit{type\_list} represents a list of glob style patterns used to match eache of the error-code list conditions. A match is declared if the \textit{type\_list} patterns or errorCode elements are exhausted (whichever comes first) and a mismatch has not occurred. If a match occurs, and \textit{ecvar} is specified, the errorCode list will be stored in \textit{ecvar} within the local scope prior to executing the \textit{body}. Moreover, if a \textit{msgvar} or \textit{infovar} are specified, the error message and errorInfo contents will be stored in the local context.

If an error occurs during the \textbf{try}, and no \textit{catch} blocks are specified, the offending error is rethrown following execution of the \textit{finally} block (if specified).

If an error occurs during execution of a \textbf{catch} or \textbf{finally} block, this error will take precedence and will propagate upwards with a new stack trace. If an error is rethrown within a catch block, the existing stack trace will be preserved with the rethrown error. This allows later discrimination of the two different error conditions (rethrown vs. unintended).

Note, \textbf{catch} \{\textit{*}\}, if specified, will catch all remaining errors. If used, it should be placed last since each of the catch blocks are evaluated in the order specified. \textit{type} is that set in errorCode, and can be any user defined type, or built-in types including POSIX *, ARITH *, CHILD *, CORE, REGEXP, WINDOWS, or NONE.

If one or more \textbf{catch} blocks are specified, and no \textbf{catch} block matches the errorCode condition, the error will be propagated up to the next level following evaluation of the \textbf{finally} clause (if specified). An enclosing \textbf{try} block (or \textbf{catch} command) can then be used to handle the error.

The \textbf{finally} block is used to perform all the clean up code. The \textbf{finally} body is evaluated whether the error occurs or not, or whether a \textbf{catch} block matched the errorCode. It is also evaluated if a \textit{throw} statement occurs within the \textbf{catch} clause.
\end{itemize}

\section{Examples}

\textbf{throw}
\begingroup\small\begin{verbatim}
    throw DEVICE "Could not write to device"
\end{verbatim}
\endgroup

\textbf{try} only (no practical use)
\begingroup\small\begin{verbatim}
    try {
       incr i
    }
\end{verbatim}
\endgroup

\textbf{try --- catch}
\begingroup\small\begin{verbatim}
    try {
       incr i
    } catch * {
       set i 0
    }
\end{verbatim}
\endgroup

\textbf{try --- finally}
\begingroup\small\begin{verbatim}
    try {
       . config -cursor watch
       #do some busy stuff here, don't care about errors
    } finally {
       . config -cursor arrow
    }
\end{verbatim}
\endgroup

\textbf{try --- catch --- catch}
\begingroup\small\begin{verbatim}
    try {
       ;# Some code that will cause an error
    } catch {{POSIX *} eCode eMessage} {
       ;# Statements to handle POSIX type errors
    } catch {NULL eCode eMessage} {
       ;# Statements to handle NULL (a user created) type errors
    } catch {* eMessage} {
       ;# Statements to handle all other errors
    }
\end{verbatim}
\endgroup

\textbf{try --- catch --- catch --- finally}
\begingroup\small\begin{verbatim}
    try {
       ;# Some code that will cause an error
    } catch {POSIX eCode eMessage} {
       ;# Statements to handle POSIX type errors
    } catch {* eCode eMessage} {
       ;# Statements to handle all other errors
    } finally {
       ;# Statements to execute whether an error occurred or not
    }
\end{verbatim}
\endgroup

Re-throw \textbf{try --- catch --- finally}
\begingroup\small\begin{verbatim}
    try {
       try {
          set b [expr {$a/0}]
       } catch {ARITH} {
          if {$a == 0} {
             throw   ;# re-throw to outer try
          }
       } finally {
          set b 1    ;# will execute before throw above
       }
    } catch {ARITH eCode eMessage} {
       ;# This will catch the inner throw
       puts "$res"
    }
\end{verbatim}
\endgroup

\section{Revisions: Tom Wilkason March 26, 2002}
\begin{itemize}
\item{}
Added additional \textit{ecvar} and \textit{infovar} optional arguments to the \textbf{catch} clause.
\item{}
All uncaught errors are propagated up after execution of the finally block (if specified).
\item{}
Unanticipated errors within a \textbf{catch} or \textbf{finally} block start a new stack trace and are propagated up.
\item{}
Additional \textit{info} optional argument added to \textbf{throw} for completeness.
\end{itemize}

\section{Reference Implementation}
\begingroup\small\begin{verbatim}
 /*
  * Implementation of try/catch and throw commands according to TIP 89
  */

 #include <tcl.h>

 /*
  * We keep a stack of contexts; whenever we have to handle an error,
  * i.e. are executing a catch {} clause, we store the current error
  * (errorCode, errorInfo and message), so that a throw with no arguments
  * can re-throw it.
  *
  * This is interpreter-specific data. Each element is a list, with the
  * last element being the most current one.
  */

 typedef struct {
   Tcl_Obj * errorCodeStack;
   Tcl_Obj * errorInfoStack;
   Tcl_Obj * errorMsgStack;
   Tcl_Obj * errorCodeName;
   Tcl_Obj * errorInfoName;
 } TryCatchTsd;

 /*
  * Throw an Exception
  *
  * throw ?<type> ?<message>? ?<info>??
  *
  * Throws an exception with the errorCode <type>, the message <message>
  * and the errorInfo <info>.
  *
  * An instance of throw with no arguments can be used within a catch or
  * finally block to immediately re-throw the current exception that is
  * being handled by the catch block.
  */

 static int
 Tcl_ThrowObjCmd (ClientData clientData, Tcl_Interp *interp,
                  int objc, Tcl_Obj *CONST objv[])
 {
   TryCatchTsd * myTsd = (TryCatchTsd *) clientData;

   if (objc < 1 || objc > 4) {
     Tcl_AppendResult (interp, "wrong # args: should be \"",
                       Tcl_GetStringFromObj (objv[0], NULL),
                       " ?<type> ?<message>? ?<info>??\"", NULL);
     return TCL_ERROR;
   }

   /*
    * Re-throw an error
    */

   if (objc < 2) {
     Tcl_Obj *errorCode, *errorInfo, *errorMsg;
     int lastelement;

     Tcl_ListObjLength (interp, myTsd->errorMsgStack, &lastelement);

     if (lastelement < 1) {
       Tcl_AppendResult (interp, "error: throw with no parameters ",
                         "outside of a catch",
                         NULL);
       return TCL_ERROR;
     }

     lastelement--;
     Tcl_ListObjIndex (interp, myTsd->errorMsgStack,
                       lastelement, &errorMsg);
     Tcl_ListObjIndex (interp, myTsd->errorCodeStack,
                       lastelement, &errorCode);
     Tcl_ListObjIndex (interp, myTsd->errorInfoStack,
                       lastelement, &errorInfo);

     Tcl_ResetResult (interp);
     Tcl_SetObjResult (interp, errorMsg);
     Tcl_SetObjErrorCode (interp, errorCode);

 #ifdef _TCLINT
     Tcl_ObjSetVar2 (interp, myTsd->errorInfoName, NULL, errorInfo,
                     TCL_GLOBAL_ONLY);
     interp->flags = ERR_IN_PROGRESS;
 #else
     Tcl_AddErrorInfo (interp, Tcl_GetStringFromObj (errorInfo, NULL));
 #endif
     return TCL_ERROR;
   }

   /*
    * throw with parameters
    */

   Tcl_ResetResult (interp);

   if (objc >= 3) {
     Tcl_SetObjResult (interp, objv[2]);
   } else {
     /*
      * fabricate some error message for human consumption
      */

     Tcl_AppendResult (interp, "error: ",
                       Tcl_GetStringFromObj (objv[1], NULL),
                       NULL);
   }

   Tcl_SetObjErrorCode (interp, objv[1]);

   if (objc >= 4) {
 #ifdef _TCLINT
     Tcl_ObjSetVar2 (interp, myTsd->errorInfoName, NULL, objv[3],
                     TCL_GLOBAL_ONLY);
     interp->flags = ERR_IN_PROGRESS;
 #else
     Tcl_AddErrorInfo (interp, Tcl_GetStringFromObj (objv[3], NULL));
 #endif
   }

   /*
    * throw error
    */

   return TCL_ERROR;
 }

 /*
  * exception handling
  *
  * try body ?catch {type-list ?ecvar? ?msgvar? ?infovar?} body ...?
  *          ?finally body?
  */

 static int
 Tcl_TryObjCmd (ClientData clientData, Tcl_Interp *interp,
                int objc, Tcl_Obj *CONST objv[])
 {
   TryCatchTsd * myTsd = (TryCatchTsd *) clientData;
   int currentIndex, finallyIndex, catchInfoLength, hasCatch;
   char * blockType;
   int res;

   /*
    * first check for syntactic correctness before doing anything
    */

   if (objc < 2) {
     Tcl_AppendResult (interp, "wrong # args: should be \"",
                       Tcl_GetStringFromObj (objv[0], NULL),
                       " body ",
                       "?catch {type-list ?ecvar? ?msgvar? ?infovar?} ",
                       "body ...? ",
                       "?finally body?\"", NULL);
     return TCL_ERROR;
   }

   currentIndex = 2;
   finallyIndex = -1;
   hasCatch = 0;

   while (currentIndex < objc) {
     blockType = Tcl_GetStringFromObj (objv[currentIndex], NULL);

     if (strcmp (blockType, "catch") == 0) {
       Tcl_Obj * typeList;
       int typeListLength;

       if (currentIndex+2 >= objc ||
           Tcl_ListObjLength (interp, objv[currentIndex+1],
                              &catchInfoLength) != TCL_OK ||
           (catchInfoLength < 1 && catchInfoLength > 4) ||
           Tcl_ListObjIndex (interp, objv[currentIndex+1],
                             0, &typeList) != TCL_OK ||
           Tcl_ListObjLength (interp, typeList,
                              &typeListLength) != TCL_OK) {
         Tcl_AppendResult (interp, "invalid syntax in catch clause: ",
                           "should be \"",
                           "catch {type-list ?ecvar? ?msgvar? ?infovar?} ",
                           "body\"", NULL);
         return TCL_ERROR;
       }
       hasCatch = 1;
       currentIndex += 3;
     }
     else if (strcmp (blockType, "finally") == 0) {
       if (currentIndex+2 != objc) {
         Tcl_AppendResult (interp, "trailing args after finally clause",
                           NULL);
         return TCL_ERROR;
       }
       finallyIndex = currentIndex;
       currentIndex += 2;
     }
     else {
       Tcl_AppendResult (interp, "invalid syntax: should be \"",
                         Tcl_GetStringFromObj (objv[0], NULL),
                         " body ",
                         "?catch {type-list ?ecvar? ?msgvar? ?infovar?} ",
                         "body ...? ",
                         "?finally body?\"", NULL);
       return TCL_ERROR;
     }
   }

   /*
    * Eval main body
    */

   res = Tcl_EvalObjEx (interp, objv[1], 0);

   /*
    * In case of error, check the catch clauses
    */

   if (res == TCL_ERROR) {
     Tcl_Obj *errorCode, *errorInfo, *errorMsg;
     int errorCodeLength, stackLength;

     errorMsg = Tcl_GetObjResult (interp);
     errorCode = Tcl_ObjGetVar2 (interp, myTsd->errorCodeName, NULL,
                                 TCL_GLOBAL_ONLY);
     errorInfo = Tcl_ObjGetVar2 (interp, myTsd->errorInfoName, NULL,
                                 TCL_GLOBAL_ONLY);

     /*
      * After an error has happened, errorCode and errorInfo should
      * exist.
      */

     if (errorCode == NULL || errorInfo == NULL) {
       Tcl_AppendResult (interp, "assertion error in try: ",
                         "no errorCode or no errorInfo",
                         NULL);
       return TCL_ERROR;
     }

     if (Tcl_ListObjLength (interp, errorCode, &errorCodeLength) != TCL_OK) {
       Tcl_AppendResult (interp, "assertion error in try: "
                         "errorCode is not a list",
                         NULL);
       return TCL_ERROR;
     }

     /*
      * push error data on stack, so that throw can rethrow the error
      */

     Tcl_ListObjAppendElement (interp, myTsd->errorMsgStack, errorMsg);
     Tcl_ListObjAppendElement (interp, myTsd->errorCodeStack, errorCode);
     Tcl_ListObjAppendElement (interp, myTsd->errorInfoStack, errorInfo);

     /*
      * Look for a matching clause
      */

     currentIndex = 2;

     while (currentIndex < objc) {
       blockType = Tcl_GetStringFromObj (objv[currentIndex], NULL);

       if (strcmp (blockType, "catch") == 0) {
         int typeListLength, matchIndex;
         Tcl_Obj *typeList;

         Tcl_ListObjIndex  (interp, objv[currentIndex+1], 0, &typeList);
         Tcl_ListObjLength (interp, typeList, &typeListLength);

         if (typeListLength > errorCodeLength) {
           currentIndex += 3;
           continue;
         }

         for (matchIndex=0; matchIndex<typeListLength; matchIndex++) {
           Tcl_Obj *errorCodeItem, *typeListItem;
           const char *errorCodeItemStr, *typeListItemStr;

           Tcl_ListObjIndex (interp, errorCode, matchIndex, &errorCodeItem);
           Tcl_ListObjIndex (interp, typeList, matchIndex, &typeListItem);

           errorCodeItemStr = Tcl_GetStringFromObj (errorCodeItem, NULL);
           typeListItemStr = Tcl_GetStringFromObj (typeListItem, NULL);

           if (!Tcl_StringMatch (errorCodeItemStr, typeListItemStr)) {
             break;
           }
         }

         if (matchIndex >= typeListLength) {
           /* matching catch clause found */
           break;
         }

         /* continue looking */
         currentIndex += 3;
       }
       else {
         /* not a catch clause - there are no matching catch clauses */
         currentIndex = objc;
         break;
       }
     }

     /*
      * Did we find a matching catch clause?
      */

     if (currentIndex < objc) {
       Tcl_Obj *ecvar, *msgvar, *infovar;

       Tcl_ListObjLength (interp, objv[currentIndex+1], &catchInfoLength);

       /*
        * set variables with error data
        */

       if (catchInfoLength >= 2) {
         Tcl_ListObjIndex (interp, objv[currentIndex+1], 1, &ecvar);
         Tcl_ObjSetVar2 (interp, ecvar, NULL, errorCode, 0);
       }

       if (catchInfoLength >= 3) {
         Tcl_ListObjIndex (interp, objv[currentIndex+1], 2, &msgvar);
         Tcl_ObjSetVar2 (interp, msgvar, NULL, errorMsg, 0);
       }

       if (catchInfoLength >= 4) {
         Tcl_ListObjIndex (interp, objv[currentIndex+1], 3, &infovar);
         Tcl_ObjSetVar2 (interp, infovar, NULL, errorInfo, 0);
       }

       /*
        * call body; the error code of this body takes precedence
        */

       res = Tcl_EvalObjEx (interp, objv[currentIndex+2], 0);
     }

     /*
      * pop error data from stack
      */

     Tcl_ListObjLength (interp, myTsd->errorMsgStack, &stackLength);
     stackLength--;
     Tcl_ListObjReplace (interp, myTsd->errorMsgStack,
                         stackLength, 1, 0, NULL);
     Tcl_ListObjReplace (interp, myTsd->errorCodeStack,
                         stackLength, 1, 0, NULL);
     Tcl_ListObjReplace (interp, myTsd->errorInfoStack,
                         stackLength, 1, 0, NULL);
   }

   /*
    * Execute finally body. Preserve errorCode and friends; they might
    * be corrupted by the code in the body - e.g. by a try in the code,
    * or in a proc called by the code.
    */

   if (finallyIndex != -1) {
     Tcl_Obj *errorCode, *errorInfo, *errorMsg;
     int finallyres, origres=res;

     errorMsg = Tcl_GetObjResult (interp);
     Tcl_IncrRefCount (errorMsg);

     if (origres == TCL_ERROR) {
       errorCode = Tcl_ObjGetVar2 (interp, myTsd->errorCodeName, NULL,
                                   TCL_GLOBAL_ONLY);
       errorInfo = Tcl_ObjGetVar2 (interp, myTsd->errorInfoName, NULL,
                                   TCL_GLOBAL_ONLY);
       Tcl_IncrRefCount (errorCode);
       Tcl_IncrRefCount (errorInfo);
     }

     finallyres = Tcl_EvalObjEx (interp, objv[finallyIndex+1], 0);

     /*
      * An Error in the finally clause takes precedence, else restore
      * previous error data
      */

     if (finallyres != TCL_OK) {
       res = finallyres;
     }
     else {
       Tcl_SetObjResult (interp, errorMsg);

       if (origres == TCL_ERROR) {
         Tcl_SetObjErrorCode (interp, errorCode);
 #ifdef _TCLINT
         Tcl_ObjSetVar2 (interp, myTsd->errorInfoName, NULL, errorInfo,
                         TCL_GLOBAL_ONLY);
         interp->flags = ERR_IN_PROGRESS;
 #else
         Tcl_AddErrorInfo (interp, Tcl_GetStringFromObj (errorInfo, NULL));
 #endif
       }
     }

     Tcl_DecrRefCount (errorMsg);

     if (origres == TCL_ERROR) {
       Tcl_DecrRefCount (errorCode);
       Tcl_DecrRefCount (errorInfo);
     }
   }

   /*
    * Pass along return code
    */

   return res;
 }

 /*
  * ----------------------------------------------------------------------
  *
  * "Main" function, install our commands in the Tcl interpreter
  *
  * ----------------------------------------------------------------------
  */

 #undef TCL_STORAGE_CLASS
 #define TCL_STORAGE_CLASS DLLEXPORT
 EXTERN int
 Trycatch_Init (Tcl_Interp *interp)
 {
   TryCatchTsd * myTsd;

 #ifdef USE_TCL_STUBS
   if (Tcl_InitStubs (interp, TCL_VERSION, 0) == NULL) {
     return TCL_ERROR;
   }
 #else
   if (Tcl_PkgRequire (interp, "Tcl", TCL_VERSION, 1) == NULL) {
     return TCL_ERROR;
   }
 #endif

   /*
    * Allocate Tsd
    */

   myTsd = (TryCatchTsd *) Tcl_Alloc (sizeof (TryCatchTsd));
   myTsd->errorCodeStack = Tcl_NewObj ();
   myTsd->errorInfoStack = Tcl_NewObj ();
   myTsd->errorMsgStack  = Tcl_NewObj ();
   myTsd->errorCodeName  = Tcl_NewStringObj ("errorCode", -1);
   myTsd->errorInfoName  = Tcl_NewStringObj ("errorInfo", -1);

   /*
    * add commands
    */

   Tcl_CreateObjCommand (interp, "throw", Tcl_ThrowObjCmd,
                         (ClientData) myTsd, NULL);
   Tcl_CreateObjCommand (interp, "try", Tcl_TryObjCmd,
                         (ClientData) myTsd, NULL);

   /*
    * Ready
    */

   Tcl_PkgProvide (interp, "trycatch", "0.1");
   return TCL_OK;
 }
\end{verbatim}
\endgroup

\section{Copyright}

This document has been placed in the public domain.

\section{Colophon}

\textit{TIP AutoGenerator --- written by Donal K. Fellows}
\end{document}
