summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-04-04 13:55:06 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-04-04 13:55:06 (GMT)
commit875ed401f93f459fbac8cfd682d6e015b10f7ad3 (patch)
treeec6d69ebd74244aa7e94ffd1a5483de0836276df /generic/tclBasic.c
parent6965ff95a63177a766b1be29435d3cf3592f593b (diff)
downloadtcl-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.c126
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;
}
/*