summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclIndexObj.c53
-rw-r--r--generic/tclResult.c51
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.