diff options
author | nijtmans <nijtmans@noemail.net> | 2010-03-30 13:17:17 (GMT) |
---|---|---|
committer | nijtmans <nijtmans@noemail.net> | 2010-03-30 13:17:17 (GMT) |
commit | 8fe08c06f775ad5de1aa635badd1c134b7cf8d00 (patch) | |
tree | a55a70484badac0ba698ce8fdce6dd6a81a47044 /generic/tclIndexObj.c | |
parent | 94e326f1ace103a9ecfc0276ed0fe4281b8392e7 (diff) | |
download | tcl-8fe08c06f775ad5de1aa635badd1c134b7cf8d00.zip tcl-8fe08c06f775ad5de1aa635badd1c134b7cf8d00.tar.gz tcl-8fe08c06f775ad5de1aa635badd1c134b7cf8d00.tar.bz2 |
[FRQ 2974744]: share exception codes (ObjType?):
further optimization, making use of indexType.
FossilOrigin-Name: 416a8249cd027578bb7ec52fbf1639e8a22d333d
Diffstat (limited to 'generic/tclIndexObj.c')
-rw-r--r-- | generic/tclIndexObj.c | 53 |
1 files changed, 52 insertions, 1 deletions
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 |