summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclCmdMZ.c15
-rw-r--r--generic/tclCompCmdsSZ.c9
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclResult.c75
5 files changed, 67 insertions, 43 deletions
diff --git a/ChangeLog b/ChangeLog
index b636744..49b408c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2010-03-27 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.h [Freq 2974744] share exception codes (ObjType?)
+ * generic/tclResult.c
+ * generic/tclCmdMZ.c
+ * generic/tclCompCmdsSZ.c
+
2010-03-26 Jan Nijtmans <nijtmans@users.sf.net>
* generic/tclExecute.c [Bug 2976508] tcl HEAD fails on HP-UX
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index e63e07c..618bb6b 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.209 2010/03/24 10:25:59 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.210 2010/03/27 22:40:13 nijtmans Exp $
*/
#include "tclInt.h"
@@ -4165,9 +4165,6 @@ TclNRTryObjCmd(
enum Handlers {
TryFinally, TryOn, TryTrap
};
- static const char *const returnCodes[] = {
- "ok", "error", "return", "break", "continue", NULL
- };
/*
* Parse the arguments. The handlers are passed to subsequent callbacks as
@@ -4217,15 +4214,7 @@ TclNRTryObjCmd(
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
- if (Tcl_GetIntFromObj(NULL, objv[i+1], &code) != TCL_OK
- && Tcl_GetIndexFromObj(NULL, objv[i+1], returnCodes,
- "code", 0, &code) != TCL_OK) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad completion code \"",
- TclGetString(objv[i+1]),
- "\": must be ok, error, return, break, "
- "continue, or an integer", NULL);
- Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL);
+ if (TCL_ERROR == TclGetCompletionCodeFromObj(interp, objv[i+1], &code)) {
Tcl_DecrRefCount(handlersObj);
return TCL_ERROR;
}
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index d8fdcd1..b19dfc8 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmdsSZ.c,v 1.6 2010/03/23 12:58:39 nijtmans Exp $
+ * RCS: @(#) $Id: tclCompCmdsSZ.c,v 1.7 2010/03/27 22:40:14 nijtmans Exp $
*/
#include "tclInt.h"
@@ -1992,9 +1992,6 @@ TclCompileTryCmd(
} else if (tokenPtr[1].size == 2
&& !strncmp(tokenPtr[1].start, "on", 2)) {
int code;
- static const char *const returnCodes[] = {
- "ok", "error", "return", "break", "continue", NULL
- };
/*
* Parse the result code to look for.
@@ -2007,9 +2004,7 @@ TclCompileTryCmd(
TclDecrRefCount(tmpObj);
goto failedToCompile;
}
- if (Tcl_GetIntFromObj(NULL, tmpObj, &code) != TCL_OK
- && Tcl_GetIndexFromObj(NULL, tmpObj, returnCodes, "",
- TCL_EXACT, &code) != TCL_OK) {
+ if (TCL_ERROR == TclGetCompletionCodeFromObj(NULL, tmpObj, &code)) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 9661894..422e203 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.465 2010/03/19 11:54:07 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.466 2010/03/27 22:40:14 nijtmans Exp $
*/
#ifndef _TCLINT
@@ -2870,6 +2870,8 @@ MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp);
MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
int *modePtr, int flags);
+MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp,
+ Tcl_Obj *value, int *code);
MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, ClientData *clientDataPtr,
int *typePtr);
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 3c329f1..4fcd285 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclResult.c,v 1.58 2010/03/24 15:33:14 dgp Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.59 2010/03/27 22:40:14 nijtmans Exp $
*/
#include "tclInt.h"
@@ -1292,12 +1292,61 @@ TclProcessReturn(
/*
*----------------------------------------------------------------------
*
+ * TclGetCompletionCodeFromObj --
+ *
+ * Parses Completion code Code
+ *
+ * Results:
+ * Returns TCL_ERROR if the value is an invalid completion code.
+ * Otherwise, returns TCL_OK, and writes the completion code to
+ * the pointer provided.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetCompletionCodeFromObj(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Obj *value,
+ int *code) /* Argument objects. */
+{
+ if (TCL_ERROR == TclGetIntFromObj(NULL, value, code)) {
+ static const char *const returnCodes[] = {
+ "ok", "error", "return", "break", "continue", NULL
+ };
+
+ if (TCL_ERROR == Tcl_GetIndexFromObj(NULL, value, returnCodes,
+ NULL, TCL_EXACT, code)) {
+ /*
+ * Value is not a legal return code.
+ */
+
+ if (interp != NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad completion code \"",
+ TclGetString(value),
+ "\": must be ok, error, return, break, "
+ "continue, or an integer", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL);
+ }
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclMergeReturnOptions --
*
* Parses, checks, and stores the options to the [return] command.
*
* Results:
- * Returns TCL_ERROR is any of the option values are invalid. Otherwise,
+ * Returns TCL_ERROR if any of the option values are invalid. Otherwise,
* returns TCL_OK, and writes the returnOpts, code, and level values to
* the pointers provided.
*
@@ -1377,28 +1426,10 @@ TclMergeReturnOptions(
*/
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_CODE], &valuePtr);
- if ((valuePtr != NULL)
- && (TCL_ERROR == TclGetIntFromObj(NULL, valuePtr, &code))) {
- static const char *const returnCodes[] = {
- "ok", "error", "return", "break", "continue", NULL
- };
-
- if (TCL_ERROR == Tcl_GetIndexFromObj(NULL, valuePtr, returnCodes,
- NULL, TCL_EXACT, &code)) {
- /*
- * Value is not a legal return code.
- */
-
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "bad completion code \"",
- TclGetString(valuePtr),
- "\": must be ok, error, return, break, "
- "continue, or an integer", NULL);
- Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL);
+ if (valuePtr != NULL) {
+ if (TCL_ERROR == TclGetCompletionCodeFromObj(interp, valuePtr, &code)) {
goto error;
}
- }
- if (valuePtr != NULL) {
Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]);
}