Author: Tom Wilkason <tom.wilkason@cox.net>
Author: Frank Pilhofer <520065607613-0001@t-online.de>
State: Withdrawn
Type: Project
Vote: Pending
Created: 11-Mar-2002
Post-History:
Discussions-To: news:comp.lang.tcl
Tcl-Version: 8.6
Obsoleted-By: 329
Abstract
This TIP proposes the addition of a try...catch...finally command to provide a more robust and powerful exception handling mechanism.
Rationale
Exceptions are currently supported very well in Tcl, in fact they are a major advantage over many other languages. However the mechanism to 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 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. try/catch are isolated commands that can easily be added, and do not interact with other commands or require other changes. 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.
Specification
I propose the following two commands be added to Tcl:
throw command.
throw ?type? ?message? ?info?
A throw command with type throws an error exception with the errorCode type. The throw command works as the error command, but the arguments are reordered to encourage the use of error-codes. The optional message and info parameters work as they do in the error command.
The throw type can be any user defined or built in type, built-in types include POSIX, ARITH, CORE, REGEXP, WINDOWS, NONE, ... The message is optional, and is the same as that issued by the catch command, error -code error "message"
An instance of throw with no arguments can be used within a catch block to immediately re-throw the current exception that is being handled by the 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 finally block (if on exists). Enclosing error handlers can then deal with the error.
Note that
throw type message infois the same as
error message info typetry command.
try body ?catch {{type_list} ?ecvar? ?msgvar? ?infovar?} body ...? ?finally body?
If one or more catch blocks are specified, each corresponding body represents a required block of code that is evaluated if the resulting errorCode matches the type condition. The required body of the finally block is evaluated following the try block and catch block (if any matches).
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 type_list patterns or errorCode elements are exhausted (whichever comes first) and a mismatch has not occurred. If a match occurs, and ecvar is specified, the errorCode list will be stored in ecvar within the local scope prior to executing the body. Moreover, if a msgvar or infovar are specified, the error message and errorInfo contents will be stored in the local context.
If an error occurs during the try, and no catch blocks are specified, the offending error is rethrown following execution of the finally block (if specified).
If an error occurs during execution of a catch or 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, catch {*}, 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. 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 catch blocks are specified, and no catch block matches the errorCode condition, the error will be propagated up to the next level following evaluation of the finally clause (if specified). An enclosing try block (or catch command) can then be used to handle the error.
The finally block is used to perform all the clean up code. The finally body is evaluated whether the error occurs or not, or whether a catch block matched the errorCode. It is also evaluated if a throw statement occurs within the catch clause.
Examples
throw
throw DEVICE "Could not write to device"
try only (no practical use)
try {
incr i
}
try - catch
try {
incr i
} catch * {
set i 0
}
try - finally
try {
. config -cursor watch
#do some busy stuff here, don't care about errors
} finally {
. config -cursor arrow
}
try - catch - catch
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
}
try - catch - catch - finally
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
}
Re-throw try - catch - finally
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"
}
Revisions: Tom Wilkason March 26, 2002
Added additional ecvar and infovar optional arguments to the catch clause.
All uncaught errors are propagated up after execution of the finally block (if specified).
Unanticipated errors within a catch or finally block start a new stack trace and are propagated up.
Additional info optional argument added to throw for completeness.
Reference Implementation
/*
* 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;
}
Copyright
This document has been placed in the public domain.