diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 15 | ||||
| -rw-r--r-- | generic/tclCompCmdsSZ.c | 9 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 | ||||
| -rw-r--r-- | generic/tclResult.c | 75 |
5 files changed, 67 insertions, 43 deletions
@@ -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]); } |