diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2011-04-04 13:55:06 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2011-04-04 13:55:06 (GMT) |
commit | 875ed401f93f459fbac8cfd682d6e015b10f7ad3 (patch) | |
tree | ec6d69ebd74244aa7e94ffd1a5483de0836276df /generic/tclBasic.c | |
parent | 6965ff95a63177a766b1be29435d3cf3592f593b (diff) | |
download | tcl-875ed401f93f459fbac8cfd682d6e015b10f7ad3.zip tcl-875ed401f93f459fbac8cfd682d6e015b10f7ad3.tar.gz tcl-875ed401f93f459fbac8cfd682d6e015b10f7ad3.tar.bz2 |
More generation of error codes ([format], [after], [trace], RE optimizer).
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r-- | generic/tclBasic.c | 126 |
1 files changed, 62 insertions, 64 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b34209b..f00864f 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2498,7 +2498,8 @@ TclRenameCommand( if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) { Tcl_AppendResult(interp, "can't rename to \"", newName, "\": command already exists", NULL); - Tcl_SetErrorCode(interp, "TCL", "RENAME", "TARGET_EXISTS", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", + "TARGET_EXISTS", NULL); result = TCL_ERROR; goto done; } @@ -3883,82 +3884,79 @@ Tcl_Canceled( register Interp *iPtr = (Interp *) interp; /* - * Has the current script in progress for this interpreter been - * canceled or is the stack being unwound due to the previous script - * cancellation? - */ + * Has the current script in progress for this interpreter been canceled + * or is the stack being unwound due to the previous script cancellation? + */ - if (TclCanceled(iPtr)) { - /* - * The CANCELED flag is a one-shot flag that is reset immediately - * upon being detected; however, if the TCL_CANCEL_UNWIND flag is - * set we will continue to report that the script in progress has - * been canceled thereby allowing the evaluation stack for the - * interp to be fully unwound. - */ + if (!TclCanceled(iPtr)) { + return TCL_OK; + } - iPtr->flags &= ~CANCELED; + /* + * The CANCELED flag is a one-shot flag that is reset immediately upon + * being detected; however, if the TCL_CANCEL_UNWIND flag is set we will + * continue to report that the script in progress has been canceled + * thereby allowing the evaluation stack for the interp to be fully + * unwound. + */ - /* - * The CANCELED flag was detected and reset; however, if the - * caller specified the TCL_CANCEL_UNWIND flag, we only return - * TCL_ERROR (indicating that the script in progress has been - * canceled) if the evaluation stack for the interp is being fully - * unwound. - */ + iPtr->flags &= ~CANCELED; - if (!(flags & TCL_CANCEL_UNWIND) - || (iPtr->flags & TCL_CANCEL_UNWIND)) { - /* - * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error - * in the interp's result; otherwise, we leave it alone. - */ + /* + * The CANCELED flag was detected and reset; however, if the caller + * specified the TCL_CANCEL_UNWIND flag, we only return TCL_ERROR + * (indicating that the script in progress has been canceled) if the + * evaluation stack for the interp is being fully unwound. + */ - if (flags & TCL_LEAVE_ERR_MSG) { - const char *id, *message = NULL; - int length; + if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) { + return TCL_OK; + } - /* - * Setup errorCode variables so that we can differentiate - * between being canceled and unwound. - */ + /* + * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the + * interp's result; otherwise, we leave it alone. + */ - if (iPtr->asyncCancelMsg != NULL) { - message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, - &length); - } else { - length = 0; - } + if (flags & TCL_LEAVE_ERR_MSG) { + const char *id, *message = NULL; + int length; - if (iPtr->flags & TCL_CANCEL_UNWIND) { - id = "IUNWIND"; - if (length == 0) { - message = "eval unwound"; - } - } else { - id = "ICANCEL"; - if (length == 0) { - message = "eval canceled"; - } - } + /* + * Setup errorCode variables so that we can differentiate between + * being canceled and unwound. + */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, message, NULL); - Tcl_SetErrorCode(interp, "TCL", id, message, NULL); - } + if (iPtr->asyncCancelMsg != NULL) { + message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length); + } else { + length = 0; + } - /* - * Return TCL_ERROR to the caller (not necessarily just the - * Tcl core itself) that indicates further processing of the - * script or command in progress should halt gracefully and as - * soon as possible. - */ + if (iPtr->flags & TCL_CANCEL_UNWIND) { + id = "IUNWIND"; + if (length == 0) { + message = "eval unwound"; + } + } else { + id = "ICANCEL"; + if (length == 0) { + message = "eval canceled"; + } + } - return TCL_ERROR; - } + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, message, NULL); + Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL); } - return TCL_OK; + /* + * Return TCL_ERROR to the caller (not necessarily just the Tcl core + * itself) that indicates further processing of the script or command in + * progress should halt gracefully and as soon as possible. + */ + + return TCL_ERROR; } /* |