[Freq 2974744] share exception codes (ObjType?)

4 files changed, 60 insertions, 43 deletions

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]);
     }