[FRQ 2974744]: share exception codes (ObjType?):

further optimization, making use of indexType.

3 files changed, 58 insertions, 51 deletions

diff --git a/ChangeLog b/ChangeLog
index 1fd071c..fdbaa8a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2010-03-30  Jan Nijtmans  <nijtmans@users.sf.net>
+
+	* generic/tclIndexObj:	[FRQ 2974744]: share exception codes (ObjType?):
+	* generic/tclResult.c:	further optimization, making use of indexType.
+
 2010-03-30  Donal K. Fellows  <dkf@users.sf.net>
 
 	TIP #362 IMPLEMENTATION
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index edb05d7..9eef11a 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIndexObj.c,v 1.58 2010/03/05 14:34:04 dkf Exp $
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.59 2010/03/30 13:17:18 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -1422,6 +1422,57 @@ PrintUsage(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+    static const char *const returnCodes[] = {
+	    "ok", "error", "return", "break", "continue", NULL
+    };
+
+    if ((value->typePtr != &indexType)
+	    && (TCL_OK == TclGetIntFromObj(NULL, value, code))) {
+	return TCL_OK;
+    }
+    if (TCL_OK == Tcl_GetIndexFromObj(
+	    NULL, value, returnCodes, NULL, TCL_EXACT, code)) {
+	return TCL_OK;
+    }
+    /*
+     * Value is not a legal completion 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;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 4fcd285..1fcdfba 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.59 2010/03/27 22:40:14 nijtmans Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.60 2010/03/30 13:17:18 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -1292,55 +1292,6 @@ 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.