diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclIndexObj.c | 53 | ||||
| -rw-r--r-- | generic/tclResult.c | 51 |
3 files changed, 58 insertions, 51 deletions
@@ -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. |