diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tcl.decls | 76 | ||||
| -rw-r--r-- | generic/tclBasic.c | 103 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 63 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 180 | ||||
| -rw-r--r-- | generic/tclCompile.c | 9 | ||||
| -rw-r--r-- | generic/tclDecls.h | 145 | ||||
| -rw-r--r-- | generic/tclEnv.c | 10 | ||||
| -rw-r--r-- | generic/tclGet.c | 50 | ||||
| -rw-r--r-- | generic/tclIOCmd.c | 9 | ||||
| -rw-r--r-- | generic/tclIOUtil.c | 103 | ||||
| -rw-r--r-- | generic/tclInt.h | 17 | ||||
| -rw-r--r-- | generic/tclNotify.c | 7 | ||||
| -rw-r--r-- | generic/tclParse.c | 70 | ||||
| -rw-r--r-- | generic/tclParseExpr.c | 22 | ||||
| -rw-r--r-- | generic/tclRegexp.c | 47 | ||||
| -rw-r--r-- | generic/tclResult.c | 28 | ||||
| -rw-r--r-- | generic/tclUtf.c | 322 | ||||
| -rw-r--r-- | generic/tclUtil.c | 142 |
18 files changed, 759 insertions, 644 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index db39a1a..c2176cf 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.105.2.5 2005/02/02 15:53:14 kennykb Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.105.2.6 2005/05/05 17:55:29 kennykb Exp $ library tcl @@ -136,7 +136,7 @@ declare 30 generic { void TclFreeObj(Tcl_Obj *objPtr) } declare 31 generic { - int Tcl_GetBoolean(Tcl_Interp *interp, CONST char *str, int *boolPtr) + int Tcl_GetBoolean(Tcl_Interp *interp, CONST char *src, int *boolPtr) } declare 32 generic { int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -146,7 +146,7 @@ declare 33 generic { unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr) } declare 34 generic { - int Tcl_GetDouble(Tcl_Interp *interp, CONST char *str, double *doublePtr) + int Tcl_GetDouble(Tcl_Interp *interp, CONST char *src, double *doublePtr) } declare 35 generic { int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -157,7 +157,7 @@ declare 36 generic { CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr) } declare 37 generic { - int Tcl_GetInt(Tcl_Interp *interp, CONST char *str, int *intPtr) + int Tcl_GetInt(Tcl_Interp *interp, CONST char *src, int *intPtr) } declare 38 generic { int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr) @@ -261,7 +261,7 @@ declare 68 generic { void Tcl_AllowExceptions(Tcl_Interp *interp) } declare 69 generic { - void Tcl_AppendElement(Tcl_Interp *interp, CONST char *string) + void Tcl_AppendElement(Tcl_Interp *interp, CONST char *element) } declare 70 generic { void Tcl_AppendResult(Tcl_Interp *interp, ...) @@ -431,10 +431,10 @@ declare 116 generic { void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData) } declare 117 generic { - char * Tcl_DStringAppend(Tcl_DString *dsPtr, CONST char *str, int length) + char * Tcl_DStringAppend(Tcl_DString *dsPtr, CONST char *bytes, int length) } declare 118 generic { - char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, CONST char *string) + char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, CONST char *element) } declare 119 generic { void Tcl_DStringEndSublist(Tcl_DString *dsPtr) @@ -467,7 +467,7 @@ declare 128 generic { CONST84_RETURN char * Tcl_ErrnoMsg(int err) } declare 129 generic { - int Tcl_Eval(Tcl_Interp *interp, CONST char *string) + int Tcl_Eval(Tcl_Interp *interp, CONST char *script) } # This is obsolete, use Tcl_FSEvalFile declare 130 generic { @@ -487,19 +487,19 @@ declare 134 generic { CONST char *cmdName) } declare 135 generic { - int Tcl_ExprBoolean(Tcl_Interp *interp, CONST char *str, int *ptr) + int Tcl_ExprBoolean(Tcl_Interp *interp, CONST char *expr, int *ptr) } declare 136 generic { int Tcl_ExprBooleanObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr) } declare 137 generic { - int Tcl_ExprDouble(Tcl_Interp *interp, CONST char *str, double *ptr) + int Tcl_ExprDouble(Tcl_Interp *interp, CONST char *expr, double *ptr) } declare 138 generic { int Tcl_ExprDoubleObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr) } declare 139 generic { - int Tcl_ExprLong(Tcl_Interp *interp, CONST char *str, long *ptr) + int Tcl_ExprLong(Tcl_Interp *interp, CONST char *expr, long *ptr) } declare 140 generic { int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr) @@ -509,7 +509,7 @@ declare 141 generic { Tcl_Obj **resultPtrPtr) } declare 142 generic { - int Tcl_ExprString(Tcl_Interp *interp, CONST char *string) + int Tcl_ExprString(Tcl_Interp *interp, CONST char *expr) } declare 143 generic { void Tcl_Finalize(void) @@ -599,7 +599,7 @@ declare 166 generic { # generic interface, so we inlcude it here for compatibility reasons. declare 167 unix { - int Tcl_GetOpenFile(Tcl_Interp *interp, CONST char *str, int forWriting, + int Tcl_GetOpenFile(Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr) } # Obsolete. Should now use Tcl_FSGetPathType which is objectified @@ -727,7 +727,7 @@ declare 202 generic { void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst) } declare 203 generic { - int Tcl_PutEnv(CONST char *string) + int Tcl_PutEnv(CONST char *assignment) } declare 204 generic { CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp) @@ -754,14 +754,14 @@ declare 211 generic { void Tcl_RegisterObjType(Tcl_ObjType *typePtr) } declare 212 generic { - Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, CONST char *string) + Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, CONST char *pattern) } declare 213 generic { int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, - CONST char *str, CONST char *start) + CONST char *text, CONST char *start) } declare 214 generic { - int Tcl_RegExpMatch(Tcl_Interp *interp, CONST char *str, + int Tcl_RegExpMatch(Tcl_Interp *interp, CONST char *text, CONST char *pattern) } declare 215 generic { @@ -821,7 +821,7 @@ declare 231 generic { int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth) } declare 232 generic { - void Tcl_SetResult(Tcl_Interp *interp, char *str, + void Tcl_SetResult(Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc) } declare 233 generic { @@ -956,7 +956,7 @@ declare 269 generic { CONST84_RETURN char * Tcl_HashStats(Tcl_HashTable *tablePtr) } declare 270 generic { - CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp, CONST char *str, + CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp, CONST char *start, CONST84 char **termPtr) } declare 271 generic { @@ -1120,7 +1120,7 @@ declare 311 generic { Tcl_Time *timePtr) } declare 312 generic { - int Tcl_NumUtfChars(CONST char *src, int len) + int Tcl_NumUtfChars(CONST char *src, int length) } declare 313 generic { int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, @@ -1165,7 +1165,7 @@ declare 325 generic { CONST84_RETURN char * Tcl_UtfAtIndex(CONST char *src, int index) } declare 326 generic { - int Tcl_UtfCharComplete(CONST char *src, int len) + int Tcl_UtfCharComplete(CONST char *src, int length) } declare 327 generic { int Tcl_UtfBackslash(CONST char *src, int *readPtr, char *dst) @@ -1247,18 +1247,18 @@ declare 351 generic { int Tcl_UniCharIsWordChar(int ch) } declare 352 generic { - int Tcl_UniCharLen(CONST Tcl_UniChar *str) + int Tcl_UniCharLen(CONST Tcl_UniChar *uniStr) } declare 353 generic { - int Tcl_UniCharNcmp(CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, - unsigned long n) + int Tcl_UniCharNcmp(CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct, + unsigned long numChars) } declare 354 generic { - char * Tcl_UniCharToUtfDString(CONST Tcl_UniChar *string, - int numChars, Tcl_DString *dsPtr) + char * Tcl_UniCharToUtfDString(CONST Tcl_UniChar *uniStr, + int uniLength, Tcl_DString *dsPtr) } declare 355 generic { - Tcl_UniChar * Tcl_UtfToUniCharDString(CONST char *string, + Tcl_UniChar * Tcl_UtfToUniCharDString(CONST char *src, int length, Tcl_DString *dsPtr) } declare 356 generic { @@ -1278,24 +1278,24 @@ declare 359 generic { CONST char *command, int length) } declare 360 generic { - int Tcl_ParseBraces(Tcl_Interp *interp, CONST char *string, int numBytes, + int Tcl_ParseBraces(Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr) } declare 361 generic { - int Tcl_ParseCommand(Tcl_Interp *interp, CONST char *string, int numBytes, + int Tcl_ParseCommand(Tcl_Interp *interp, CONST char *start, int numBytes, int nested, Tcl_Parse *parsePtr) } declare 362 generic { - int Tcl_ParseExpr(Tcl_Interp *interp, CONST char *string, int numBytes, + int Tcl_ParseExpr(Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr) } declare 363 generic { - int Tcl_ParseQuotedString(Tcl_Interp *interp, CONST char *string, + int Tcl_ParseQuotedString(Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr) } declare 364 generic { - int Tcl_ParseVarName(Tcl_Interp *interp, CONST char *string, int numBytes, + int Tcl_ParseVarName(Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append) } # These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir, @@ -1335,7 +1335,7 @@ declare 375 generic { } declare 376 generic { int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, - Tcl_Obj *objPtr, int offset, int nmatches, int flags) + Tcl_Obj *textObj, int offset, int nmatches, int flags) } declare 377 generic { void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr) @@ -1364,7 +1364,7 @@ declare 384 generic { int length) } declare 385 generic { - int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *stringObj, + int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj) } declare 386 generic { @@ -1479,12 +1479,12 @@ declare 418 generic { } declare 419 generic { - int Tcl_UniCharNcasecmp(CONST Tcl_UniChar *cs, CONST Tcl_UniChar *ct, - unsigned long n) + int Tcl_UniCharNcasecmp(CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct, + unsigned long numChars) } declare 420 generic { - int Tcl_UniCharCaseMatch(CONST Tcl_UniChar *ustr, - CONST Tcl_UniChar *pattern, int nocase) + int Tcl_UniCharCaseMatch(CONST Tcl_UniChar *uniStr, + CONST Tcl_UniChar *uniPattern, int nocase) } declare 421 generic { diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b7c1a1b..1aaf783 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.136.2.7 2005/04/25 21:37:19 kennykb Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.136.2.8 2005/05/05 17:55:30 kennykb Exp $ */ #include "tclInt.h" @@ -1963,8 +1963,7 @@ TclInvokeObjectCommand(clientData, interp, argc, argv) for (i = 0; i < argc; i++) { length = strlen(argv[i]); - TclNewObj(objPtr); - TclInitStringRep(objPtr, argv[i], length); + TclNewStringObj(objPtr, argv[i], length); Tcl_IncrRefCount(objPtr); objv[i] = objPtr; } @@ -3956,12 +3955,12 @@ Tcl_EvalEx(interp, script, numBytes, flags) */ int -Tcl_Eval(interp, string) +Tcl_Eval(interp, script) Tcl_Interp *interp; /* Token for command interpreter (returned * by previous call to Tcl_CreateInterp). */ - CONST char *string; /* Pointer to TCL command to execute. */ + CONST char *script; /* Pointer to TCL command to execute. */ { - int code = Tcl_EvalEx(interp, string, -1, 0); + int code = Tcl_EvalEx(interp, script, -1, 0); /* * For backwards compatibility with old C code that predates the @@ -4197,19 +4196,19 @@ ProcessUnexpectedResult(interp, returnCode) */ int -Tcl_ExprLong(interp, string, ptr) +Tcl_ExprLong(interp, exprstring, ptr) Tcl_Interp *interp; /* Context in which to evaluate the * expression. */ - CONST char *string; /* Expression to evaluate. */ + CONST char *exprstring; /* Expression to evaluate. */ long *ptr; /* Where to store result. */ { register Tcl_Obj *exprPtr; Tcl_Obj *resultPtr; - int length = strlen(string); + int length = strlen(exprstring); int result = TCL_OK; if (length > 0) { - TclNewStringObj(exprPtr, string, length); + exprPtr = Tcl_NewStringObj(exprstring, length); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprObj(interp, exprPtr, &resultPtr); if (result == TCL_OK) { @@ -4265,19 +4264,19 @@ Tcl_ExprLong(interp, string, ptr) } int -Tcl_ExprDouble(interp, string, ptr) +Tcl_ExprDouble(interp, exprstring, ptr) Tcl_Interp *interp; /* Context in which to evaluate the * expression. */ - CONST char *string; /* Expression to evaluate. */ + CONST char *exprstring; /* Expression to evaluate. */ double *ptr; /* Where to store result. */ { register Tcl_Obj *exprPtr; Tcl_Obj *resultPtr; - int length = strlen(string); + int length = strlen(exprstring); int result = TCL_OK; if (length > 0) { - TclNewStringObj(exprPtr, string, length); + exprPtr = Tcl_NewStringObj(exprstring, length); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprObj(interp, exprPtr, &resultPtr); if (result == TCL_OK) { @@ -4333,19 +4332,19 @@ Tcl_ExprDouble(interp, string, ptr) } int -Tcl_ExprBoolean(interp, string, ptr) +Tcl_ExprBoolean(interp, exprstring, ptr) Tcl_Interp *interp; /* Context in which to evaluate the * expression. */ - CONST char *string; /* Expression to evaluate. */ + CONST char *exprstring; /* Expression to evaluate. */ int *ptr; /* Where to store 0/1 result. */ { register Tcl_Obj *exprPtr; Tcl_Obj *resultPtr; - int length = strlen(string); + int length = strlen(exprstring); int result = TCL_OK; if (length > 0) { - TclNewStringObj(exprPtr, string, length); + exprPtr = Tcl_NewStringObj(exprstring, length); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprObj(interp, exprPtr, &resultPtr); if (result == TCL_OK) { @@ -4633,61 +4632,29 @@ TclObjInvoke(interp, objc, objv, flags) */ int -Tcl_ExprString(interp, string) +Tcl_ExprString(interp, expr) Tcl_Interp *interp; /* Context in which to evaluate the * expression. */ - CONST char *string; /* Expression to evaluate. */ + CONST char *expr; /* Expression to evaluate. */ { - register Tcl_Obj *exprPtr; - Tcl_Obj *resultPtr; - int length = strlen(string); - char buf[TCL_DOUBLE_SPACE]; - int result = TCL_OK; - - if (length > 0) { - TclNewObj(exprPtr); - TclInitStringRep(exprPtr, string, length); - Tcl_IncrRefCount(exprPtr); - - result = Tcl_ExprObj(interp, exprPtr, &resultPtr); - if (result == TCL_OK) { - /* - * Set the interpreter's string result from the result object. - */ - - if (resultPtr->typePtr == &tclIntType) { - sprintf(buf, "%ld", resultPtr->internalRep.longValue); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else if (resultPtr->typePtr == &tclDoubleType) { - Tcl_PrintDouble((Tcl_Interp *) NULL, - resultPtr->internalRep.doubleValue, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else { - /* - * Set interpreter's string result from the result object. - */ - - Tcl_SetResult(interp, TclGetString(resultPtr), - TCL_VOLATILE); - } - Tcl_DecrRefCount(resultPtr); /* discard the result object */ - } else { - /* - * Move the interpreter's object result to the string result, - * then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - } - Tcl_DecrRefCount(exprPtr); /* discard the expression object */ - } else { - /* - * An empty string. Just set the interpreter's result to 0. - */ - + int code = TCL_OK; + if (expr[0] == '\0') { + /* An empty string. Just set the interpreter's result to 0. */ Tcl_SetResult(interp, "0", TCL_VOLATILE); + } else { + Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, -1); + Tcl_IncrRefCount(exprObj); + code = Tcl_ExprObj(interp, exprObj, &resultPtr); + Tcl_DecrRefCount(exprObj); + if (code == TCL_OK) { + Tcl_SetObjResult(interp, resultPtr); + Tcl_DecrRefCount(resultPtr); + } + + /* Force the string rep of the interp result */ + (void) Tcl_GetStringResult(interp); } - return result; + return code; } /* diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 54e8b61..958a03d 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.115.2.3 2005/04/10 23:14:46 kennykb Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.115.2.4 2005/05/05 17:55:32 kennykb Exp $ */ #include "tclInt.h" @@ -90,7 +90,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) int i, indices, match, about, offset, all, doinline, numMatchesSaved; int cflags, eflags, stringLength; Tcl_RegExp regExpr; - Tcl_Obj *objPtr, *resultPtr = NULL; + Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL; Tcl_RegExpInfo info; static CONST char *options[] = { "-all", "-about", "-indices", "-inline", @@ -121,7 +121,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) } if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT, &index) != TCL_OK) { - return TCL_ERROR; + goto optionError; } switch ((enum options) index) { case REGEXP_ALL: { @@ -161,15 +161,18 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) break; } case REGEXP_START: { + int temp; if (++i >= objc) { goto endOfForLoop; } - if (Tcl_GetIntFromObj(interp, objv[i], &offset) != TCL_OK) { - return TCL_ERROR; + if (TclGetIntForIndex(interp, objv[i], 0, &temp) != TCL_OK) { + goto optionError; } - if (offset < 0) { - offset = 0; + if (startIndex) { + Tcl_DecrRefCount(startIndex); } + startIndex = objv[i]; + Tcl_IncrRefCount(startIndex); break; } case REGEXP_LAST: { @@ -183,7 +186,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) if ((objc - i) < (2 - about)) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"); - return TCL_ERROR; + goto optionError; } objc -= i; objv += i; @@ -194,7 +197,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) */ Tcl_AppendResult(interp, "regexp match variables not allowed", " when using -inline", (char *) NULL); - return TCL_ERROR; + goto optionError; } /* @@ -203,6 +206,10 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) if (about) { regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if ((regExpr == NULL) || (TclRegAbout(interp, regExpr) < 0)) { +optionError: + if (startIndex) { + Tcl_DecrRefCount(startIndex); + } return TCL_ERROR; } return TCL_OK; @@ -216,6 +223,14 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) objPtr = objv[1]; stringLength = Tcl_GetCharLength(objPtr); + if (startIndex) { + TclGetIntForIndex(NULL, startIndex, stringLength, &offset); + Tcl_DecrRefCount(startIndex); + if (offset < 0) { + offset = 0; + } + } + regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if (regExpr == NULL) { return TCL_ERROR; @@ -426,7 +441,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) int start, end, subStart, subEnd, match; Tcl_RegExp regExpr; Tcl_RegExpInfo info; - Tcl_Obj *resultPtr, *subPtr, *objPtr; + Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL; Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend; static CONST char *options[] = { @@ -455,7 +470,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) } if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch", TCL_EXACT, &index) != TCL_OK) { - return TCL_ERROR; + goto optionError; } switch ((enum options) index) { case REGSUB_ALL: { @@ -483,15 +498,18 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) break; } case REGSUB_START: { + int temp; if (++idx >= objc) { goto endOfForLoop; } - if (Tcl_GetIntFromObj(interp, objv[idx], &offset) != TCL_OK) { - return TCL_ERROR; + if (TclGetIntForIndex(interp, objv[idx], 0, &temp) != TCL_OK) { + goto optionError; } - if (offset < 0) { - offset = 0; + if (startIndex) { + Tcl_DecrRefCount(startIndex); } + startIndex = objv[idx]; + Tcl_IncrRefCount(startIndex); break; } case REGSUB_LAST: { @@ -504,12 +522,25 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) if (objc-idx < 3 || objc-idx > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? exp string subSpec ?varName?"); - return TCL_ERROR; +optionError: + if (startIndex) { + Tcl_DecrRefCount(startIndex); + } + return TCL_ERROR; } objc -= idx; objv += idx; + if (startIndex) { + int stringLength = Tcl_GetCharLength(objv[1]); + TclGetIntForIndex(NULL, startIndex, stringLength, &offset); + Tcl_DecrRefCount(startIndex); + if (offset < 0) { + offset = 0; + } + } + if (all && (offset == 0) && (strpbrk(TclGetString(objv[2]), "&\\") == NULL) && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) { diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 229e809..04ba646 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.59.2.2 2005/04/10 23:14:47 kennykb Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.59.2.3 2005/05/05 17:55:34 kennykb Exp $ */ #include "tclInt.h" @@ -53,7 +53,7 @@ AuxDataType tclForeachInfoType = { * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "append" command @@ -74,7 +74,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr) numWords = parsePtr->numWords; if (numWords == 1) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } else if (numWords == 2) { /* * append varName == set varName @@ -84,7 +84,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr) /* * APPEND instructions currently only handle one value */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -160,7 +160,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "break" command @@ -177,7 +177,7 @@ TclCompileBreakCmd(interp, parsePtr, envPtr) CompileEnv *envPtr; /* Holds resulting instructions. */ { if (parsePtr->numWords != 1) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -197,7 +197,7 @@ TclCompileBreakCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "catch" command @@ -224,7 +224,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) * compile. Let runtime checks determine if syntax has changed. */ if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -234,7 +234,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) */ if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -251,13 +251,13 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) name = nameTokenPtr[1].start; nameChars = nameTokenPtr[1].size; if (!TclIsLocalScalar(name, nameChars)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } localIndex = TclFindCompiledLocal(nameTokenPtr[1].start, nameTokenPtr[1].size, /*create*/ 1, /*flags*/ VAR_SCALAR, envPtr->procPtr); } else { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } } @@ -358,7 +358,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "continue" command @@ -379,7 +379,7 @@ TclCompileContinueCmd(interp, parsePtr, envPtr) */ if (parsePtr->numWords != 1) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -399,7 +399,7 @@ TclCompileContinueCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "expr" command @@ -418,7 +418,7 @@ TclCompileExprCmd(interp, parsePtr, envPtr) Tcl_Token *firstWordPtr; if (parsePtr->numWords == 1) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } firstWordPtr = parsePtr->tokenPtr @@ -436,7 +436,7 @@ TclCompileExprCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "for" command @@ -458,7 +458,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) int savedStackDepth = envPtr->currStackDepth; if (parsePtr->numWords != 5) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -471,7 +471,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) + (parsePtr->tokenPtr->numComponents + 1); testTokenPtr = startTokenPtr + (startTokenPtr->numComponents + 1); if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -483,7 +483,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1); if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -608,7 +608,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "foreach" command @@ -657,12 +657,12 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) */ if (procPtr == NULL) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } numWords = parsePtr->numWords; if ((numWords < 4) || (numWords%2 != 0)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -675,7 +675,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) } bodyTokenPtr = tokenPtr; if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -712,7 +712,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) i++, tokenPtr += (tokenPtr->numComponents + 1)) { if (i%2 == 1) { if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } else { /* Lots of copying going on here. Need a ListObj wizard @@ -727,14 +727,14 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) &varcList[loopIndex], &varvList[loopIndex]); Tcl_DStringFree(&varList); if (code != TCL_OK) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } numVars = varcList[loopIndex]; for (j = 0; j < numVars; j++) { CONST char *varName = varvList[loopIndex][j]; if (!TclIsLocalScalar(varName, (int) strlen(varName))) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } } @@ -1014,7 +1014,7 @@ FreeForeachInfo(clientData) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "if" command @@ -1060,7 +1060,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) for (wordIdx = 0; wordIdx < numWords; wordIdx++) { if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } tokenPtr += 2; } @@ -1092,7 +1092,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) break; } if (wordIdx >= numWords) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } @@ -1145,7 +1145,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1); wordIdx++; if (wordIdx >= numWords) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { @@ -1155,7 +1155,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) tokenPtr += (tokenPtr->numComponents + 1); wordIdx++; if (wordIdx >= numWords) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } } @@ -1246,7 +1246,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) tokenPtr += (tokenPtr->numComponents + 1); wordIdx++; if (wordIdx >= numWords) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } } @@ -1266,7 +1266,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) wordIdx++; if (wordIdx < numWords) { - code = TCL_OUT_LINE_COMPILE; + code = TCL_ERROR; goto done; } } else { @@ -1329,7 +1329,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "incr" command @@ -1349,7 +1349,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) int simpleVarName, isScalar, localIndex, haveImmValue, immValue; if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } varTokenPtr = parsePtr->tokenPtr @@ -1457,7 +1457,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lappend" command @@ -1480,18 +1480,18 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) * If we're not in a procedure, don't compile. */ if (envPtr->procPtr == NULL) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } numWords = parsePtr->numWords; if (numWords == 1) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if (numWords != 3) { /* * LAPPEND instructions currently only handle one value appends */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -1570,7 +1570,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lassign" command @@ -1594,7 +1594,7 @@ TclCompileLassignCmd(interp, parsePtr, envPtr) * Check for command syntax error, but we'll punt that to runtime */ if (numWords < 3) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -1680,7 +1680,7 @@ TclCompileLassignCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lindex" command @@ -1705,7 +1705,7 @@ TclCompileLindexCmd(interp, parsePtr, envPtr) */ if (numWords <= 1) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } varTokenPtr = parsePtr->tokenPtr @@ -1750,7 +1750,7 @@ TclCompileLindexCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "list" command @@ -1770,7 +1770,7 @@ TclCompileListCmd(interp, parsePtr, envPtr) * If we're not in a procedure, don't compile. */ if (envPtr->procPtr == NULL) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if (parsePtr->numWords == 1) { @@ -1815,7 +1815,7 @@ TclCompileListCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "llength" command @@ -1834,7 +1834,7 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr) Tcl_Token *varTokenPtr; if (parsePtr->numWords != 2) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } varTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); @@ -1863,7 +1863,7 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "lset" command @@ -1914,7 +1914,7 @@ TclCompileLsetCmd(interp, parsePtr, envPtr) if (parsePtr->numWords < 3) { /* Fail at run time, not in compilation */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -2044,7 +2044,7 @@ TclCompileLsetCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "regexp" command @@ -2072,7 +2072,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) * regexp ?-nocase? ?--? {^staticString$} $var */ if (parsePtr->numWords < 3) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } nocase = 0; @@ -2087,7 +2087,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* Not a simple string - punt to runtime. */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } str = (char *) varTokenPtr[1].start; len = varTokenPtr[1].size; @@ -2099,13 +2099,13 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) nocase = 1; } else { /* Not an option we recognize. */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } } if ((parsePtr->numWords - i) != 2) { /* We don't support capturing to variables */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -2116,7 +2116,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) str = (char *) varTokenPtr[1].start; len = varTokenPtr[1].size; if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (*str == '-')) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if (len == 0) { @@ -2176,7 +2176,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) if ((strpbrk(str + start, "*+?{}()[].\\|^$") != NULL) || (Tcl_RegExpCompile(NULL, str) == NULL)) { ckfree((char *) str); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if (anchorLeft && anchorRight) { @@ -2234,7 +2234,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "return" command @@ -2303,7 +2303,7 @@ cleanup: * must be interpreted at runtime. */ Tcl_ResetResult(interp); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -2376,7 +2376,7 @@ cleanup: * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "set" command @@ -2397,7 +2397,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr) numWords = parsePtr->numWords; if ((numWords != 2) && (numWords != 3)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } isAssignment = (numWords == 3); @@ -2482,7 +2482,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "string" command @@ -2521,7 +2521,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) if (parsePtr->numWords < 2) { /* Fail at run time, not in compilation */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } opTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); @@ -2531,7 +2531,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) &index) != TCL_OK) { Tcl_DecrRefCount(opObj); Tcl_ResetResult(interp); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } Tcl_DecrRefCount(opObj); @@ -2557,7 +2557,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) /* * All other cases: compile out of line. */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; case STR_COMPARE: case STR_EQUAL: { @@ -2568,7 +2568,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) */ if (parsePtr->numWords != 4) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -2595,7 +2595,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) if (parsePtr->numWords != 4) { /* Fail at run time, not in compilation */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -2619,7 +2619,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) case STR_LENGTH: { if (parsePtr->numWords != 3) { /* Fail at run time, not in compilation */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { @@ -2646,12 +2646,12 @@ TclCompileStringCmd(interp, parsePtr, envPtr) if (parsePtr->numWords < 4 || parsePtr->numWords > 5) { /* Fail at run time, not in compilation */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if (parsePtr->numWords == 5) { if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } str = varTokenPtr[1].start; length = varTokenPtr[1].size; @@ -2660,7 +2660,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) nocase = 1; } else { /* Fail at run time, not in compilation */ - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); } @@ -2714,7 +2714,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) * Procedure called to compile the "switch" command. * * Results: - * Returns TCL_OK for successful compile, or TCL_OUT_LINE_COMPILE + * Returns TCL_OK for successful compile, or TCL_ERROR * to defer evaluation to runtime (either when it is too complex * to get the semantics right, or when we know for sure that it * is an error but need the error to happen at the right time). @@ -2794,7 +2794,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) */ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } else { register int size = tokenPtr[1].size; register CONST char *chrs = tokenPtr[1].start; @@ -2803,7 +2803,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) * Assume that -e and -g are unique prefixes of -exact and -glob */ if (size < 2) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } if ((size <= 6) && (numWords >= 4) && !strncmp(chrs, "-exact", (unsigned) TclMin(size, 6))) { @@ -2823,12 +2823,12 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) */ mode = Switch_Exact; } else { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } } if ((tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (tokenPtr[1].size != 2) || strncmp(tokenPtr[1].start, "--", 2)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } tokenPtr += 2; numWords--; @@ -2865,19 +2865,19 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) */ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } Tcl_DStringInit(&bodyList); Tcl_DStringAppend(&bodyList, tokenPtr[1].start, tokenPtr[1].size); if (Tcl_SplitList(NULL, Tcl_DStringValue(&bodyList), &numWords, &argv) != TCL_OK) { Tcl_DStringFree(&bodyList); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } Tcl_DStringFree(&bodyList); if (numWords == 0 || numWords % 2) { ckfree((char *) argv); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } bodyTokenArray = (Tcl_Token *) ckalloc(sizeof(Tcl_Token) * numWords); bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords); @@ -2910,7 +2910,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) ckfree((char *) argv); ckfree((char *) bodyToken); ckfree((char *) bodyTokenArray); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } while (isspace(UCHAR(*tokenStartPtr))) { tokenStartPtr++; @@ -2934,10 +2934,10 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) if (tokenStartPtr != tokenPtr[1].start+tokenPtr[1].size) { ckfree((char *) bodyToken); ckfree((char *) bodyTokenArray); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } } else if (numWords % 2 || numWords == 0) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } else { bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords); bodyTokenArray = NULL; @@ -2950,7 +2950,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr->numComponents != 1) { ckfree((char *) bodyToken); - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } bodyToken[i] = tokenPtr+1; tokenPtr += tokenPtr->numComponents+1; @@ -2969,7 +2969,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) if (bodyTokenArray != NULL) { ckfree((char *) bodyTokenArray); } - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -3140,7 +3140,7 @@ TclCompileSwitchCmd(interp, parsePtr, envPtr) * "variable" command. The command itself is *not* compiled. * * Results: - * Always returns TCL_OUT_LINE_COMPILE. + * Always returns TCL_ERROR. * * Side effects: * Indexed local variables are added to the environment. @@ -3159,7 +3159,7 @@ TclCompileVariableCmd(interp, parsePtr, envPtr) CONST char *varName, *tail; if (envPtr->procPtr == NULL) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } numWords = parsePtr->numWords; @@ -3182,7 +3182,7 @@ TclCompileVariableCmd(interp, parsePtr, envPtr) varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); } } - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -3194,7 +3194,7 @@ TclCompileVariableCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "while" command @@ -3221,7 +3221,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) int boolVal; if (parsePtr->numWords != 3) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -3238,7 +3238,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1); if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) { - return TCL_OUT_LINE_COMPILE; + return TCL_ERROR; } /* @@ -3371,7 +3371,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) * * Results: * Returns TCL_OK for a successful compile. - * Returns TCL_OUT_LINE_COMPILE to defer evaluation to runtime. + * Returns TCL_ERROR to defer evaluation to runtime. * * Side effects: * Instructions are added to envPtr to execute the "set" command diff --git a/generic/tclCompile.c b/generic/tclCompile.c index f539bf2..5d85b6d 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.78.2.4 2005/04/25 21:37:19 kennykb Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.78.2.5 2005/05/05 17:55:51 kennykb Exp $ */ #include "tclInt.h" @@ -1128,18 +1128,17 @@ TclCompileScript(interp, script, numBytes, envPtr) TclStoreInt4AtPtr(fixLen, fixPtr); } goto finishCommand; - } else if (code == TCL_OUT_LINE_COMPILE) { + } else { /* * Restore numCommands and codeNext to their * correct values, removing any commands - * compiled before TCL_OUT_LINE_COMPILE + * compiled before the failure to produce + * bytecode got reported. * [Bugs 705406 and 735055] */ envPtr->numCommands = savedNumCmds; envPtr->codeNext = envPtr->codeStart + savedCodeNext; - } else { /* an error */ - Tcl_Panic("TclCompileScript: compileProc returned TCL_ERROR\n"); } } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 8dacbb6..4d37ef7 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -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: tclDecls.h,v 1.107.2.4 2005/02/02 15:53:18 kennykb Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.107.2.5 2005/05/05 17:55:53 kennykb Exp $ */ #ifndef _TCLDECLS @@ -227,7 +227,7 @@ EXTERN void TclFreeObj _ANSI_ARGS_((Tcl_Obj * objPtr)); #define Tcl_GetBoolean_TCL_DECLARED /* 31 */ EXTERN int Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, int * boolPtr)); + CONST char * src, int * boolPtr)); #endif #ifndef Tcl_GetBooleanFromObj_TCL_DECLARED #define Tcl_GetBooleanFromObj_TCL_DECLARED @@ -246,7 +246,7 @@ EXTERN unsigned char * Tcl_GetByteArrayFromObj _ANSI_ARGS_(( #define Tcl_GetDouble_TCL_DECLARED /* 34 */ EXTERN int Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, double * doublePtr)); + CONST char * src, double * doublePtr)); #endif #ifndef Tcl_GetDoubleFromObj_TCL_DECLARED #define Tcl_GetDoubleFromObj_TCL_DECLARED @@ -266,7 +266,7 @@ EXTERN int Tcl_GetIndexFromObj _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_GetInt_TCL_DECLARED /* 37 */ EXTERN int Tcl_GetInt _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, int * intPtr)); + CONST char * src, int * intPtr)); #endif #ifndef Tcl_GetIntFromObj_TCL_DECLARED #define Tcl_GetIntFromObj_TCL_DECLARED @@ -456,7 +456,7 @@ EXTERN void Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp * interp)); #define Tcl_AppendElement_TCL_DECLARED /* 69 */ EXTERN void Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string)); + CONST char * element)); #endif #ifndef Tcl_AppendResult_TCL_DECLARED #define Tcl_AppendResult_TCL_DECLARED @@ -772,13 +772,13 @@ EXTERN void Tcl_DoWhenIdle _ANSI_ARGS_((Tcl_IdleProc * proc, #define Tcl_DStringAppend_TCL_DECLARED /* 117 */ EXTERN char * Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString * dsPtr, - CONST char * str, int length)); + CONST char * bytes, int length)); #endif #ifndef Tcl_DStringAppendElement_TCL_DECLARED #define Tcl_DStringAppendElement_TCL_DECLARED /* 118 */ EXTERN char * Tcl_DStringAppendElement _ANSI_ARGS_(( - Tcl_DString * dsPtr, CONST char * string)); + Tcl_DString * dsPtr, CONST char * element)); #endif #ifndef Tcl_DStringEndSublist_TCL_DECLARED #define Tcl_DStringEndSublist_TCL_DECLARED @@ -839,7 +839,7 @@ EXTERN CONST84_RETURN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err)); #define Tcl_Eval_TCL_DECLARED /* 129 */ EXTERN int Tcl_Eval _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string)); + CONST char * script)); #endif #ifndef Tcl_EvalFile_TCL_DECLARED #define Tcl_EvalFile_TCL_DECLARED @@ -876,7 +876,7 @@ EXTERN int Tcl_ExposeCommand _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ExprBoolean_TCL_DECLARED /* 135 */ EXTERN int Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, int * ptr)); + CONST char * expr, int * ptr)); #endif #ifndef Tcl_ExprBooleanObj_TCL_DECLARED #define Tcl_ExprBooleanObj_TCL_DECLARED @@ -888,7 +888,7 @@ EXTERN int Tcl_ExprBooleanObj _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ExprDouble_TCL_DECLARED /* 137 */ EXTERN int Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, double * ptr)); + CONST char * expr, double * ptr)); #endif #ifndef Tcl_ExprDoubleObj_TCL_DECLARED #define Tcl_ExprDoubleObj_TCL_DECLARED @@ -900,7 +900,7 @@ EXTERN int Tcl_ExprDoubleObj _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ExprLong_TCL_DECLARED /* 139 */ EXTERN int Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, long * ptr)); + CONST char * expr, long * ptr)); #endif #ifndef Tcl_ExprLongObj_TCL_DECLARED #define Tcl_ExprLongObj_TCL_DECLARED @@ -918,7 +918,7 @@ EXTERN int Tcl_ExprObj _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ExprString_TCL_DECLARED /* 142 */ EXTERN int Tcl_ExprString _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string)); + CONST char * expr)); #endif #ifndef Tcl_Finalize_TCL_DECLARED #define Tcl_Finalize_TCL_DECLARED @@ -1068,7 +1068,7 @@ EXTERN Tcl_Obj * Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp * interp)); #define Tcl_GetOpenFile_TCL_DECLARED /* 167 */ EXTERN int Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, int forWriting, + CONST char * chanID, int forWriting, int checkUsage, ClientData * filePtr)); #endif #endif /* UNIX */ @@ -1291,7 +1291,7 @@ EXTERN void Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp * interp, #ifndef Tcl_PutEnv_TCL_DECLARED #define Tcl_PutEnv_TCL_DECLARED /* 203 */ -EXTERN int Tcl_PutEnv _ANSI_ARGS_((CONST char * string)); +EXTERN int Tcl_PutEnv _ANSI_ARGS_((CONST char * assignment)); #endif #ifndef Tcl_PosixError_TCL_DECLARED #define Tcl_PosixError_TCL_DECLARED @@ -1353,20 +1353,20 @@ EXTERN void Tcl_RegisterObjType _ANSI_ARGS_(( #define Tcl_RegExpCompile_TCL_DECLARED /* 212 */ EXTERN Tcl_RegExp Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string)); + CONST char * pattern)); #endif #ifndef Tcl_RegExpExec_TCL_DECLARED #define Tcl_RegExpExec_TCL_DECLARED /* 213 */ EXTERN int Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_RegExp regexp, CONST char * str, + Tcl_RegExp regexp, CONST char * text, CONST char * start)); #endif #ifndef Tcl_RegExpMatch_TCL_DECLARED #define Tcl_RegExpMatch_TCL_DECLARED /* 214 */ EXTERN int Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, CONST char * pattern)); + CONST char * text, CONST char * pattern)); #endif #ifndef Tcl_RegExpRange_TCL_DECLARED #define Tcl_RegExpRange_TCL_DECLARED @@ -1473,7 +1473,7 @@ EXTERN int Tcl_SetRecursionLimit _ANSI_ARGS_(( #define Tcl_SetResult_TCL_DECLARED /* 232 */ EXTERN void Tcl_SetResult _ANSI_ARGS_((Tcl_Interp * interp, - char * str, Tcl_FreeProc * freeProc)); + char * result, Tcl_FreeProc * freeProc)); #endif #ifndef Tcl_SetServiceMode_TCL_DECLARED #define Tcl_SetServiceMode_TCL_DECLARED @@ -1718,7 +1718,7 @@ EXTERN CONST84_RETURN char * Tcl_HashStats _ANSI_ARGS_(( #define Tcl_ParseVar_TCL_DECLARED /* 270 */ EXTERN CONST84_RETURN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * str, CONST84 char ** termPtr)); + CONST char * start, CONST84 char ** termPtr)); #endif #ifndef Tcl_PkgPresent_TCL_DECLARED #define Tcl_PkgPresent_TCL_DECLARED @@ -1970,7 +1970,7 @@ EXTERN void Tcl_ConditionWait _ANSI_ARGS_(( #define Tcl_NumUtfChars_TCL_DECLARED /* 312 */ EXTERN int Tcl_NumUtfChars _ANSI_ARGS_((CONST char * src, - int len)); + int length)); #endif #ifndef Tcl_ReadChars_TCL_DECLARED #define Tcl_ReadChars_TCL_DECLARED @@ -2052,7 +2052,7 @@ EXTERN CONST84_RETURN char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src, #define Tcl_UtfCharComplete_TCL_DECLARED /* 326 */ EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src, - int len)); + int length)); #endif #ifndef Tcl_UtfBackslash_TCL_DECLARED #define Tcl_UtfBackslash_TCL_DECLARED @@ -2197,26 +2197,28 @@ EXTERN int Tcl_UniCharIsWordChar _ANSI_ARGS_((int ch)); #ifndef Tcl_UniCharLen_TCL_DECLARED #define Tcl_UniCharLen_TCL_DECLARED /* 352 */ -EXTERN int Tcl_UniCharLen _ANSI_ARGS_((CONST Tcl_UniChar * str)); +EXTERN int Tcl_UniCharLen _ANSI_ARGS_(( + CONST Tcl_UniChar * uniStr)); #endif #ifndef Tcl_UniCharNcmp_TCL_DECLARED #define Tcl_UniCharNcmp_TCL_DECLARED /* 353 */ -EXTERN int Tcl_UniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar * cs, - CONST Tcl_UniChar * ct, unsigned long n)); +EXTERN int Tcl_UniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar * ucs, + CONST Tcl_UniChar * uct, + unsigned long numChars)); #endif #ifndef Tcl_UniCharToUtfDString_TCL_DECLARED #define Tcl_UniCharToUtfDString_TCL_DECLARED /* 354 */ EXTERN char * Tcl_UniCharToUtfDString _ANSI_ARGS_(( - CONST Tcl_UniChar * string, int numChars, + CONST Tcl_UniChar * uniStr, int uniLength, Tcl_DString * dsPtr)); #endif #ifndef Tcl_UtfToUniCharDString_TCL_DECLARED #define Tcl_UtfToUniCharDString_TCL_DECLARED /* 355 */ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString _ANSI_ARGS_(( - CONST char * string, int length, + CONST char * src, int length, Tcl_DString * dsPtr)); #endif #ifndef Tcl_GetRegExpFromObj_TCL_DECLARED @@ -2248,7 +2250,7 @@ EXTERN void Tcl_LogCommandInfo _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ParseBraces_TCL_DECLARED /* 360 */ EXTERN int Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string, int numBytes, + CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); #endif @@ -2256,21 +2258,21 @@ EXTERN int Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ParseCommand_TCL_DECLARED /* 361 */ EXTERN int Tcl_ParseCommand _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string, int numBytes, - int nested, Tcl_Parse * parsePtr)); + CONST char * start, int numBytes, int nested, + Tcl_Parse * parsePtr)); #endif #ifndef Tcl_ParseExpr_TCL_DECLARED #define Tcl_ParseExpr_TCL_DECLARED /* 362 */ EXTERN int Tcl_ParseExpr _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string, int numBytes, + CONST char * start, int numBytes, Tcl_Parse * parsePtr)); #endif #ifndef Tcl_ParseQuotedString_TCL_DECLARED #define Tcl_ParseQuotedString_TCL_DECLARED /* 363 */ EXTERN int Tcl_ParseQuotedString _ANSI_ARGS_(( - Tcl_Interp * interp, CONST char * string, + Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); #endif @@ -2278,7 +2280,7 @@ EXTERN int Tcl_ParseQuotedString _ANSI_ARGS_(( #define Tcl_ParseVarName_TCL_DECLARED /* 364 */ EXTERN int Tcl_ParseVarName _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string, int numBytes, + CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append)); #endif #ifndef Tcl_GetCwd_TCL_DECLARED @@ -2345,7 +2347,7 @@ EXTERN int Tcl_UniCharIsPunct _ANSI_ARGS_((int ch)); #define Tcl_RegExpExecObj_TCL_DECLARED /* 376 */ EXTERN int Tcl_RegExpExecObj _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_RegExp regexp, Tcl_Obj * objPtr, + Tcl_RegExp regexp, Tcl_Obj * textObj, int offset, int nmatches, int flags)); #endif #ifndef Tcl_RegExpGetInfo_TCL_DECLARED @@ -2398,7 +2400,7 @@ EXTERN void Tcl_AppendUnicodeToObj _ANSI_ARGS_((Tcl_Obj * objPtr, #define Tcl_RegExpMatchObj_TCL_DECLARED /* 385 */ EXTERN int Tcl_RegExpMatchObj _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_Obj * stringObj, Tcl_Obj * patternObj)); + Tcl_Obj * textObj, Tcl_Obj * patternObj)); #endif #ifndef Tcl_SetNotifier_TCL_DECLARED #define Tcl_SetNotifier_TCL_DECLARED @@ -2597,15 +2599,16 @@ EXTERN int Tcl_IsChannelExisting _ANSI_ARGS_(( #define Tcl_UniCharNcasecmp_TCL_DECLARED /* 419 */ EXTERN int Tcl_UniCharNcasecmp _ANSI_ARGS_(( - CONST Tcl_UniChar * cs, - CONST Tcl_UniChar * ct, unsigned long n)); + CONST Tcl_UniChar * ucs, + CONST Tcl_UniChar * uct, + unsigned long numChars)); #endif #ifndef Tcl_UniCharCaseMatch_TCL_DECLARED #define Tcl_UniCharCaseMatch_TCL_DECLARED /* 420 */ EXTERN int Tcl_UniCharCaseMatch _ANSI_ARGS_(( - CONST Tcl_UniChar * ustr, - CONST Tcl_UniChar * pattern, int nocase)); + CONST Tcl_UniChar * uniStr, + CONST Tcl_UniChar * uniPattern, int nocase)); #endif #ifndef Tcl_FindHashEntry_TCL_DECLARED #define Tcl_FindHashEntry_TCL_DECLARED @@ -3533,13 +3536,13 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_DbNewStringObj) _ANSI_ARGS_((CONST char * bytes, int length, CONST char * file, int line)); /* 28 */ Tcl_Obj * (*tcl_DuplicateObj) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 29 */ void (*tclFreeObj) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 30 */ - int (*tcl_GetBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * boolPtr)); /* 31 */ + int (*tcl_GetBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * src, int * boolPtr)); /* 31 */ int (*tcl_GetBooleanFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * boolPtr)); /* 32 */ unsigned char * (*tcl_GetByteArrayFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 33 */ - int (*tcl_GetDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, double * doublePtr)); /* 34 */ + int (*tcl_GetDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * src, double * doublePtr)); /* 34 */ int (*tcl_GetDoubleFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, double * doublePtr)); /* 35 */ int (*tcl_GetIndexFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CONST84 char ** tablePtr, CONST char * msg, int flags, int * indexPtr)); /* 36 */ - int (*tcl_GetInt) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * intPtr)); /* 37 */ + int (*tcl_GetInt) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * src, int * intPtr)); /* 37 */ int (*tcl_GetIntFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * intPtr)); /* 38 */ int (*tcl_GetLongFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * longPtr)); /* 39 */ Tcl_ObjType * (*tcl_GetObjType) _ANSI_ARGS_((CONST char * typeName)); /* 40 */ @@ -3571,7 +3574,7 @@ typedef struct TclStubs { void (*tcl_AddErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message)); /* 66 */ void (*tcl_AddObjErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message, int length)); /* 67 */ void (*tcl_AllowExceptions) _ANSI_ARGS_((Tcl_Interp * interp)); /* 68 */ - void (*tcl_AppendElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 69 */ + void (*tcl_AppendElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * element)); /* 69 */ void (*tcl_AppendResult) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 70 */ Tcl_AsyncHandler (*tcl_AsyncCreate) _ANSI_ARGS_((Tcl_AsyncProc * proc, ClientData clientData)); /* 71 */ void (*tcl_AsyncDelete) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 72 */ @@ -3624,8 +3627,8 @@ typedef struct TclStubs { void (*tcl_DontCallWhenDeleted) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 114 */ int (*tcl_DoOneEvent) _ANSI_ARGS_((int flags)); /* 115 */ void (*tcl_DoWhenIdle) _ANSI_ARGS_((Tcl_IdleProc * proc, ClientData clientData)); /* 116 */ - char * (*tcl_DStringAppend) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * str, int length)); /* 117 */ - char * (*tcl_DStringAppendElement) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * string)); /* 118 */ + char * (*tcl_DStringAppend) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * bytes, int length)); /* 117 */ + char * (*tcl_DStringAppendElement) _ANSI_ARGS_((Tcl_DString * dsPtr, CONST char * element)); /* 118 */ void (*tcl_DStringEndSublist) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 119 */ void (*tcl_DStringFree) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 120 */ void (*tcl_DStringGetResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * dsPtr)); /* 121 */ @@ -3636,20 +3639,20 @@ typedef struct TclStubs { int (*tcl_Eof) _ANSI_ARGS_((Tcl_Channel chan)); /* 126 */ CONST84_RETURN char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */ CONST84_RETURN char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */ - int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 129 */ + int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script)); /* 129 */ int (*tcl_EvalFile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * fileName)); /* 130 */ int (*tcl_EvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 131 */ void (*tcl_EventuallyFree) _ANSI_ARGS_((ClientData clientData, Tcl_FreeProc * freeProc)); /* 132 */ void (*tcl_Exit) _ANSI_ARGS_((int status)); /* 133 */ int (*tcl_ExposeCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * hiddenCmdToken, CONST char * cmdName)); /* 134 */ - int (*tcl_ExprBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * ptr)); /* 135 */ + int (*tcl_ExprBoolean) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * expr, int * ptr)); /* 135 */ int (*tcl_ExprBooleanObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * ptr)); /* 136 */ - int (*tcl_ExprDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, double * ptr)); /* 137 */ + int (*tcl_ExprDouble) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * expr, double * ptr)); /* 137 */ int (*tcl_ExprDoubleObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, double * ptr)); /* 138 */ - int (*tcl_ExprLong) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, long * ptr)); /* 139 */ + int (*tcl_ExprLong) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * expr, long * ptr)); /* 139 */ int (*tcl_ExprLongObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * ptr)); /* 140 */ int (*tcl_ExprObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Obj ** resultPtrPtr)); /* 141 */ - int (*tcl_ExprString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 142 */ + int (*tcl_ExprString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * expr)); /* 142 */ void (*tcl_Finalize) _ANSI_ARGS_((void)); /* 143 */ void (*tcl_FindExecutable) _ANSI_ARGS_((CONST char * argv0)); /* 144 */ Tcl_HashEntry * (*tcl_FirstHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, Tcl_HashSearch * searchPtr)); /* 145 */ @@ -3675,7 +3678,7 @@ typedef struct TclStubs { CONST char * (*tcl_GetNameOfExecutable) _ANSI_ARGS_((void)); /* 165 */ Tcl_Obj * (*tcl_GetObjResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 166 */ #if !defined(__WIN32__) /* UNIX */ - int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int forWriting, int checkUsage, ClientData * filePtr)); /* 167 */ + int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * chanID, int forWriting, int checkUsage, ClientData * filePtr)); /* 167 */ #endif /* UNIX */ #ifdef __WIN32__ void *reserved167; @@ -3720,7 +3723,7 @@ typedef struct TclStubs { Tcl_Channel (*tcl_OpenTcpServer) _ANSI_ARGS_((Tcl_Interp * interp, int port, CONST char * host, Tcl_TcpAcceptProc * acceptProc, ClientData callbackData)); /* 200 */ void (*tcl_Preserve) _ANSI_ARGS_((ClientData data)); /* 201 */ void (*tcl_PrintDouble) _ANSI_ARGS_((Tcl_Interp * interp, double value, char * dst)); /* 202 */ - int (*tcl_PutEnv) _ANSI_ARGS_((CONST char * string)); /* 203 */ + int (*tcl_PutEnv) _ANSI_ARGS_((CONST char * assignment)); /* 203 */ CONST84_RETURN char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 204 */ void (*tcl_QueueEvent) _ANSI_ARGS_((Tcl_Event * evPtr, Tcl_QueuePosition position)); /* 205 */ int (*tcl_Read) _ANSI_ARGS_((Tcl_Channel chan, char * bufPtr, int toRead)); /* 206 */ @@ -3734,9 +3737,9 @@ typedef struct TclStubs { int (*tcl_RecordAndEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * cmdPtr, int flags)); /* 209 */ void (*tcl_RegisterChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 210 */ void (*tcl_RegisterObjType) _ANSI_ARGS_((Tcl_ObjType * typePtr)); /* 211 */ - Tcl_RegExp (*tcl_RegExpCompile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 212 */ - int (*tcl_RegExpExec) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, CONST char * str, CONST char * start)); /* 213 */ - int (*tcl_RegExpMatch) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CONST char * pattern)); /* 214 */ + Tcl_RegExp (*tcl_RegExpCompile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pattern)); /* 212 */ + int (*tcl_RegExpExec) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, CONST char * text, CONST char * start)); /* 213 */ + int (*tcl_RegExpMatch) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * text, CONST char * pattern)); /* 214 */ void (*tcl_RegExpRange) _ANSI_ARGS_((Tcl_RegExp regexp, int index, CONST84 char ** startPtr, CONST84 char ** endPtr)); /* 215 */ void (*tcl_Release) _ANSI_ARGS_((ClientData clientData)); /* 216 */ void (*tcl_ResetResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 217 */ @@ -3754,7 +3757,7 @@ typedef struct TclStubs { void (*tcl_SetMaxBlockTime) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 229 */ void (*tcl_SetPanicProc) _ANSI_ARGS_((Tcl_PanicProc * panicProc)); /* 230 */ int (*tcl_SetRecursionLimit) _ANSI_ARGS_((Tcl_Interp * interp, int depth)); /* 231 */ - void (*tcl_SetResult) _ANSI_ARGS_((Tcl_Interp * interp, char * str, Tcl_FreeProc * freeProc)); /* 232 */ + void (*tcl_SetResult) _ANSI_ARGS_((Tcl_Interp * interp, char * result, Tcl_FreeProc * freeProc)); /* 232 */ int (*tcl_SetServiceMode) _ANSI_ARGS_((int mode)); /* 233 */ void (*tcl_SetObjErrorCode) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * errorObjPtr)); /* 234 */ void (*tcl_SetObjResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * resultObjPtr)); /* 235 */ @@ -3792,7 +3795,7 @@ typedef struct TclStubs { void (*tcl_AppendResultVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 267 */ void (*tcl_AppendStringsToObjVA) _ANSI_ARGS_((Tcl_Obj * objPtr, va_list argList)); /* 268 */ CONST84_RETURN char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */ - CONST84_RETURN char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CONST84 char ** termPtr)); /* 270 */ + CONST84_RETURN char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, CONST84 char ** termPtr)); /* 270 */ CONST84_RETURN char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 271 */ CONST84_RETURN char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 272 */ int (*tcl_PkgProvide) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version)); /* 273 */ @@ -3834,7 +3837,7 @@ typedef struct TclStubs { void (*tcl_MutexUnlock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 309 */ void (*tcl_ConditionNotify) _ANSI_ARGS_((Tcl_Condition * condPtr)); /* 310 */ void (*tcl_ConditionWait) _ANSI_ARGS_((Tcl_Condition * condPtr, Tcl_Mutex * mutexPtr, Tcl_Time * timePtr)); /* 311 */ - int (*tcl_NumUtfChars) _ANSI_ARGS_((CONST char * src, int len)); /* 312 */ + int (*tcl_NumUtfChars) _ANSI_ARGS_((CONST char * src, int length)); /* 312 */ int (*tcl_ReadChars) _ANSI_ARGS_((Tcl_Channel channel, Tcl_Obj * objPtr, int charsToRead, int appendFlag)); /* 313 */ void (*tcl_RestoreResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 314 */ void (*tcl_SaveResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 315 */ @@ -3848,7 +3851,7 @@ typedef struct TclStubs { Tcl_UniChar (*tcl_UniCharToUpper) _ANSI_ARGS_((int ch)); /* 323 */ int (*tcl_UniCharToUtf) _ANSI_ARGS_((int ch, char * buf)); /* 324 */ CONST84_RETURN char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */ - int (*tcl_UtfCharComplete) _ANSI_ARGS_((CONST char * src, int len)); /* 326 */ + int (*tcl_UtfCharComplete) _ANSI_ARGS_((CONST char * src, int length)); /* 326 */ int (*tcl_UtfBackslash) _ANSI_ARGS_((CONST char * src, int * readPtr, char * dst)); /* 327 */ CONST84_RETURN char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char * src, int ch)); /* 328 */ CONST84_RETURN char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */ @@ -3874,19 +3877,19 @@ typedef struct TclStubs { int (*tcl_UniCharIsSpace) _ANSI_ARGS_((int ch)); /* 349 */ int (*tcl_UniCharIsUpper) _ANSI_ARGS_((int ch)); /* 350 */ int (*tcl_UniCharIsWordChar) _ANSI_ARGS_((int ch)); /* 351 */ - int (*tcl_UniCharLen) _ANSI_ARGS_((CONST Tcl_UniChar * str)); /* 352 */ - int (*tcl_UniCharNcmp) _ANSI_ARGS_((CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 353 */ - char * (*tcl_UniCharToUtfDString) _ANSI_ARGS_((CONST Tcl_UniChar * string, int numChars, Tcl_DString * dsPtr)); /* 354 */ - Tcl_UniChar * (*tcl_UtfToUniCharDString) _ANSI_ARGS_((CONST char * string, int length, Tcl_DString * dsPtr)); /* 355 */ + int (*tcl_UniCharLen) _ANSI_ARGS_((CONST Tcl_UniChar * uniStr)); /* 352 */ + int (*tcl_UniCharNcmp) _ANSI_ARGS_((CONST Tcl_UniChar * ucs, CONST Tcl_UniChar * uct, unsigned long numChars)); /* 353 */ + char * (*tcl_UniCharToUtfDString) _ANSI_ARGS_((CONST Tcl_UniChar * uniStr, int uniLength, Tcl_DString * dsPtr)); /* 354 */ + Tcl_UniChar * (*tcl_UtfToUniCharDString) _ANSI_ARGS_((CONST char * src, int length, Tcl_DString * dsPtr)); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * patObj, int flags)); /* 356 */ Tcl_Obj * (*tcl_EvalTokens) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 357 */ void (*tcl_FreeParse) _ANSI_ARGS_((Tcl_Parse * parsePtr)); /* 358 */ void (*tcl_LogCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script, CONST char * command, int length)); /* 359 */ - int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 360 */ - int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */ - int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr)); /* 362 */ - int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 363 */ - int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */ + int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 360 */ + int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */ + int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr)); /* 362 */ + int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 363 */ + int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * start, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */ char * (*tcl_GetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 365 */ int (*tcl_Chdir) _ANSI_ARGS_((CONST char * dirName)); /* 366 */ int (*tcl_Access) _ANSI_ARGS_((CONST char * path, int mode)); /* 367 */ @@ -3898,7 +3901,7 @@ typedef struct TclStubs { int (*tcl_UniCharIsGraph) _ANSI_ARGS_((int ch)); /* 373 */ int (*tcl_UniCharIsPrint) _ANSI_ARGS_((int ch)); /* 374 */ int (*tcl_UniCharIsPunct) _ANSI_ARGS_((int ch)); /* 375 */ - int (*tcl_RegExpExecObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, Tcl_Obj * objPtr, int offset, int nmatches, int flags)); /* 376 */ + int (*tcl_RegExpExecObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_RegExp regexp, Tcl_Obj * textObj, int offset, int nmatches, int flags)); /* 376 */ void (*tcl_RegExpGetInfo) _ANSI_ARGS_((Tcl_RegExp regexp, Tcl_RegExpInfo * infoPtr)); /* 377 */ Tcl_Obj * (*tcl_NewUnicodeObj) _ANSI_ARGS_((CONST Tcl_UniChar * unicode, int numChars)); /* 378 */ void (*tcl_SetUnicodeObj) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int numChars)); /* 379 */ @@ -3907,7 +3910,7 @@ typedef struct TclStubs { Tcl_UniChar * (*tcl_GetUnicode) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 382 */ Tcl_Obj * (*tcl_GetRange) _ANSI_ARGS_((Tcl_Obj * objPtr, int first, int last)); /* 383 */ void (*tcl_AppendUnicodeToObj) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST Tcl_UniChar * unicode, int length)); /* 384 */ - int (*tcl_RegExpMatchObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * stringObj, Tcl_Obj * patternObj)); /* 385 */ + int (*tcl_RegExpMatchObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * textObj, Tcl_Obj * patternObj)); /* 385 */ void (*tcl_SetNotifier) _ANSI_ARGS_((Tcl_NotifierProcs * notifierProcPtr)); /* 386 */ Tcl_Mutex * (*tcl_GetAllocMutex) _ANSI_ARGS_((void)); /* 387 */ int (*tcl_GetChannelNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 388 */ @@ -3941,8 +3944,8 @@ typedef struct TclStubs { void (*tcl_SpliceChannel) _ANSI_ARGS_((Tcl_Channel channel)); /* 416 */ void (*tcl_ClearChannelHandlers) _ANSI_ARGS_((Tcl_Channel channel)); /* 417 */ int (*tcl_IsChannelExisting) _ANSI_ARGS_((CONST char* channelName)); /* 418 */ - int (*tcl_UniCharNcasecmp) _ANSI_ARGS_((CONST Tcl_UniChar * cs, CONST Tcl_UniChar * ct, unsigned long n)); /* 419 */ - int (*tcl_UniCharCaseMatch) _ANSI_ARGS_((CONST Tcl_UniChar * ustr, CONST Tcl_UniChar * pattern, int nocase)); /* 420 */ + int (*tcl_UniCharNcasecmp) _ANSI_ARGS_((CONST Tcl_UniChar * ucs, CONST Tcl_UniChar * uct, unsigned long numChars)); /* 419 */ + int (*tcl_UniCharCaseMatch) _ANSI_ARGS_((CONST Tcl_UniChar * uniStr, CONST Tcl_UniChar * uniPattern, int nocase)); /* 420 */ Tcl_HashEntry * (*tcl_FindHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, CONST char * key)); /* 421 */ Tcl_HashEntry * (*tcl_CreateHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, CONST char * key, int * newPtr)); /* 422 */ void (*tcl_InitCustomHashTable) _ANSI_ARGS_((Tcl_HashTable * tablePtr, int keyType, Tcl_HashKeyType * typePtr)); /* 423 */ diff --git a/generic/tclEnv.c b/generic/tclEnv.c index af7ddcd..d831e6f 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.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: tclEnv.c,v 1.22 2004/04/06 22:25:50 dgp Exp $ + * RCS: @(#) $Id: tclEnv.c,v 1.22.2.1 2005/05/05 17:56:02 kennykb Exp $ */ #include "tclInt.h" @@ -320,15 +320,15 @@ TclSetEnv(name, value) */ int -Tcl_PutEnv(string) - CONST char *string; /* Info about environment variable in the +Tcl_PutEnv(assignment) + CONST char *assignment; /* Info about environment variable in the * form NAME=value. (native) */ { Tcl_DString nameString; CONST char *name; char *value; - if (string == NULL) { + if (assignment == NULL) { return 0; } @@ -338,7 +338,7 @@ Tcl_PutEnv(string) * all of the real work. */ - name = Tcl_ExternalToUtfDString(NULL, string, -1, &nameString); + name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString); value = strchr(name, '='); if ((value != NULL) && (value != name)) { diff --git a/generic/tclGet.c b/generic/tclGet.c index 0be4b7e..7451e6a 100644 --- a/generic/tclGet.c +++ b/generic/tclGet.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclGet.c,v 1.9.2.3 2005/04/25 21:37:20 kennykb Exp $ + * RCS: @(#) $Id: tclGet.c,v 1.9.2.4 2005/05/05 17:56:02 kennykb Exp $ */ #include "tclInt.h" @@ -26,8 +26,8 @@ * * Results: * The return value is normally TCL_OK; in this case *intPtr - * will be set to the integer value equivalent to string. If - * string is improperly formed then TCL_ERROR is returned and + * will be set to the integer value equivalent to src. If + * src is improperly formed then TCL_ERROR is returned and * an error message will be left in the interp's result. * * Side effects: @@ -37,9 +37,9 @@ */ int -Tcl_GetInt(interp, str, intPtr) +Tcl_GetInt(interp, src, intPtr) Tcl_Interp *interp; /* Interpreter to use for error reporting. */ - CONST char *str; /* String containing a (possibly signed) + CONST char *src; /* String containing a (possibly signed) * integer in a form acceptable to strtoul. */ int *intPtr; /* Place to store converted result. */ { @@ -47,8 +47,8 @@ Tcl_GetInt(interp, str, intPtr) int code; obj.refCount = 1; - obj.bytes = (char *) str; - obj.length = strlen(str); + obj.bytes = (char *) src; + obj.length = strlen(src); obj.typePtr = NULL; code = Tcl_GetIntFromObj(interp, &obj, intPtr); @@ -69,8 +69,8 @@ Tcl_GetInt(interp, str, intPtr) * * Results: * The return value is normally TCL_OK; in this case *longPtr - * will be set to the long integer value equivalent to string. If - * string is improperly formed then TCL_ERROR is returned and + * will be set to the long integer value equivalent to src. If + * src is improperly formed then TCL_ERROR is returned and * an error message will be left in the interp's result if interp * is non-NULL. * @@ -81,10 +81,10 @@ Tcl_GetInt(interp, str, intPtr) */ int -TclGetLong(interp, str, longPtr) +TclGetLong(interp, src, longPtr) Tcl_Interp *interp; /* Interpreter used for error reporting * if not NULL. */ - CONST char *str; /* String containing a (possibly signed) + CONST char *src; /* String containing a (possibly signed) * long integer in a form acceptable to * strtoul. */ long *longPtr; /* Place to store converted long result. */ @@ -93,8 +93,8 @@ TclGetLong(interp, str, longPtr) int code; obj.refCount = 1; - obj.bytes = (char *) str; - obj.length = strlen(str); + obj.bytes = (char *) src; + obj.length = strlen(src); obj.typePtr = NULL; code = Tcl_GetLongFromObj(interp, &obj, longPtr); @@ -114,8 +114,8 @@ TclGetLong(interp, str, longPtr) * * Results: * The return value is normally TCL_OK; in this case *doublePtr - * will be set to the double-precision value equivalent to string. - * If string is improperly formed then TCL_ERROR is returned and + * will be set to the double-precision value equivalent to src. + * If src is improperly formed then TCL_ERROR is returned and * an error message will be left in the interp's result. * * Side effects: @@ -125,9 +125,9 @@ TclGetLong(interp, str, longPtr) */ int -Tcl_GetDouble(interp, str, doublePtr) +Tcl_GetDouble(interp, src, doublePtr) Tcl_Interp *interp; /* Interpreter used for error reporting. */ - CONST char *str; /* String containing a floating-point number + CONST char *src; /* String containing a floating-point number * in a form acceptable to strtod. */ double *doublePtr; /* Place to store converted result. */ { @@ -135,8 +135,8 @@ Tcl_GetDouble(interp, str, doublePtr) int code; obj.refCount = 1; - obj.bytes = (char *) str; - obj.length = strlen(str); + obj.bytes = (char *) src; + obj.length = strlen(src); obj.typePtr = NULL; code = Tcl_GetDoubleFromObj(interp, &obj, doublePtr); @@ -156,8 +156,8 @@ Tcl_GetDouble(interp, str, doublePtr) * * Results: * The return value is normally TCL_OK; in this case *boolPtr - * will be set to the 0/1 value equivalent to string. If - * string is improperly formed then TCL_ERROR is returned and + * will be set to the 0/1 value equivalent to src. If + * src is improperly formed then TCL_ERROR is returned and * an error message will be left in the interp's result. * * Side effects: @@ -167,9 +167,9 @@ Tcl_GetDouble(interp, str, doublePtr) */ int -Tcl_GetBoolean(interp, str, boolPtr) +Tcl_GetBoolean(interp, src, boolPtr) Tcl_Interp *interp; /* Interpreter used for error reporting. */ - CONST char *str; /* String containing a boolean number + CONST char *src; /* String containing a boolean number * specified either as 1/0 or true/false or * yes/no. */ int *boolPtr; /* Place to store converted result, which @@ -179,8 +179,8 @@ Tcl_GetBoolean(interp, str, boolPtr) int code; obj.refCount = 1; - obj.bytes = (char *) str; - obj.length = strlen(str); + obj.bytes = (char *) src; + obj.length = strlen(src); obj.typePtr = NULL; code = Tcl_ConvertToType(interp, &obj, &tclBooleanType); diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 732b162..358c32b 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.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: tclIOCmd.c,v 1.22 2004/10/07 00:24:49 dgp Exp $ + * RCS: @(#) $Id: tclIOCmd.c,v 1.22.2.1 2005/05/05 17:56:03 kennykb Exp $ */ #include "tclInt.h" @@ -960,14 +960,14 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv) if (!pipeline) { chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot); } else { - int mode, seekFlag, cmdObjc; + int mode, seekFlag, cmdObjc, binary; CONST char **cmdArgv; if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) { return TCL_ERROR; } - mode = TclGetOpenMode(interp, modeString, &seekFlag); + mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary); if (mode == -1) { chan = NULL; } else { @@ -987,6 +987,9 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv) break; } chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags); + if (binary) { + Tcl_SetChannelOption(interp, chan, "-translation", "binary"); + } } ckfree((char *) cmdArgv); } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 5e7863f..2eb01f8 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.113.2.2 2005/04/25 21:37:21 kennykb Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.113.2.3 2005/05/05 17:56:03 kennykb Exp $ */ #include "tclInt.h" @@ -1412,9 +1412,43 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr) * TclGetOpenMode -- * * Description: + * This routine is an obsolete, limited version of + * TclGetOpenModeEx() below. It exists only to satisfy any + * extensions imprudently using it via Tcl's internal stubs table. + * + * Results: + * Same as TclGetOpenModeEx(). + * + * Side effects: + * Same as TclGetOpenModeEx(). + * + *--------------------------------------------------------------------------- + */ + +int +TclGetOpenMode(interp, modeString, seekFlagPtr) + Tcl_Interp *interp; /* Interpreter to use for error + * reporting - may be NULL. */ + CONST char *modeString; /* Mode string, e.g. "r+" or + * "RDONLY CREAT". */ + int *seekFlagPtr; /* Set this to 1 if the caller + * should seek to EOF during the + * opening of the file. */ +{ + int binary = 0; + return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary); +} + +/* + *--------------------------------------------------------------------------- + * + * TclGetOpenModeEx -- + * + * Description: * Computes a POSIX mode mask for opening a file, from a given string, - * and also sets a flag to indicate whether the caller should seek to - * EOF after opening the file. + * and also sets flags to indicate whether the caller should seek to + * EOF after opening the file, and whether the caller should + * configure the channel for binary data. * * Results: * On success, returns mode to pass to "open". If an error occurs, the @@ -1423,7 +1457,9 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr) * * Side effects: * Sets the integer referenced by seekFlagPtr to 1 to tell the caller - * to seek to EOF after opening the file. + * to seek to EOF after opening the file, or to 0 otherwise. Sets the + * integer referenced by binaryPtr to 1 to tell the caller to seek to + * configure the channel for binary data, or to 0 otherwise. * * Special note: * This code is based on a prototype implementation contributed @@ -1431,16 +1467,18 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr) * *--------------------------------------------------------------------------- */ - int -TclGetOpenMode(interp, string, seekFlagPtr) +TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr) Tcl_Interp *interp; /* Interpreter to use for error * reporting - may be NULL. */ - CONST char *string; /* Mode string, e.g. "r+" or + CONST char *modeString; /* Mode string, e.g. "r+" or * "RDONLY CREAT". */ int *seekFlagPtr; /* Set this to 1 if the caller * should seek to EOF during the * opening of the file. */ + int *binaryPtr; /* Set this to 1 if the caller + * should configure the opened + * channel for binary operations */ { int mode, modeArgc, c, i, gotRW; CONST char **modeArgv, *flag; @@ -1453,6 +1491,7 @@ TclGetOpenMode(interp, string, seekFlagPtr) */ *seekFlagPtr = 0; + *binaryPtr = 0; mode = 0; /* @@ -1460,9 +1499,9 @@ TclGetOpenMode(interp, string, seekFlagPtr) * routines. */ - if (!(string[0] & 0x80) - && islower(UCHAR(string[0]))) { /* INTL: ISO only. */ - switch (string[0]) { + if (!(modeString[0] & 0x80) + && islower(UCHAR(modeString[0]))) { /* INTL: ISO only. */ + switch (modeString[0]) { case 'r': mode = O_RDONLY; break; @@ -1475,20 +1514,33 @@ TclGetOpenMode(interp, string, seekFlagPtr) break; default: error: + *seekFlagPtr = 0; + *binaryPtr = 0; if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, - "illegal access mode \"", string, "\"", + "illegal access mode \"", modeString, "\"", (char *) NULL); } return -1; } - if (string[1] == '+') { - mode &= ~(O_RDONLY|O_WRONLY); - mode |= O_RDWR; - if (string[2] != 0) { + i=1; + while (i<3 && modeString[i]) { + if (modeString[i] == modeString[i-1]) { goto error; } - } else if (string[1] != 0) { + switch (modeString[i++]) { + case '+': + mode &= ~(O_RDONLY|O_WRONLY); + mode |= O_RDWR; + break; + case 'b': + *binaryPtr = 1; + break; + default: + goto error; + } + } + if (modeString[i] != 0) { goto error; } return mode; @@ -1502,11 +1554,11 @@ TclGetOpenMode(interp, string, seekFlagPtr) * a NULL interpreter is passed in. */ - if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) { + if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) { if (interp != (Tcl_Interp *) NULL) { Tcl_AddErrorInfo(interp, "\n while processing open access modes \""); - Tcl_AddErrorInfo(interp, string); + Tcl_AddErrorInfo(interp, modeString); Tcl_AddErrorInfo(interp, "\""); } return -1; @@ -1560,11 +1612,14 @@ TclGetOpenMode(interp, string, seekFlagPtr) #endif } else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) { mode |= O_TRUNC; + } else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) { + *binaryPtr = 1; } else { if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "invalid access mode \"", flag, - "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT", - " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL); + "\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, " + "CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC", + (char *) NULL); } ckfree((char *) modeArgv); return -1; @@ -2086,8 +2141,8 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions) if (fsPtr != NULL) { Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc; if (proc != NULL) { - int mode, seekFlag; - mode = TclGetOpenMode(interp, modeString, &seekFlag); + int mode, seekFlag, binary; + mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary); if (mode == -1) { return NULL; } @@ -2106,6 +2161,10 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions) return NULL; } } + if (binary) { + Tcl_SetChannelOption(interp, retVal, + "-translation", "binary"); + } } return retVal; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 04b80ec..35baea3 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -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: tclInt.h,v 1.202.2.11 2005/04/25 21:37:22 kennykb Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.202.2.12 2005/05/05 17:56:06 kennykb Exp $ */ #ifndef _TCLINT @@ -916,18 +916,21 @@ struct CompileEnv; * must be one of the following: * * TCL_OK Compilation completed normally. - * TCL_OUT_LINE_COMPILE Compilation could not be completed. This can + * TCL_ERROR Compilation could not be completed. This can * be just a judgment by the CompileProc that the * command is too complex to compile effectively, * or it can indicate that in the current state of * the interp, the command would raise an error. - * In the latter circumstance, we defer error reporting + * The bytecode compiler will not do any error reporting + * at compiler time. Error reporting is deferred * until the actual runtime, because by then changes * in the interp state may allow the command to be - * successfully evaluated. + * successfully evaluated. + * TCL_OUT_LINE_COMPILE A source-compatible alias for TCL_ERROR, kept + * for the sake of old code only. */ -#define TCL_OUT_LINE_COMPILE (TCL_CONTINUE + 1) +#define TCL_OUT_LINE_COMPILE TCL_ERROR typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *compEnvPtr)); @@ -1893,7 +1896,9 @@ MODULE_SCOPE int TclGetEncodingFromObj _ANSI_ARGS_((Tcl_Interp *interp, MODULE_SCOPE int TclGetNamespaceFromObj _ANSI_ARGS_(( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr)); - +MODULE_SCOPE int TclGetOpenModeEx _ANSI_ARGS_((Tcl_Interp *interp, + CONST char *modeString, int *seekFlagPtr, + int *binaryPtr)); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue _ANSI_ARGS_ (( ProcessGlobalValue *pgvPtr)); MODULE_SCOPE int TclGlob _ANSI_ARGS_((Tcl_Interp *interp, diff --git a/generic/tclNotify.c b/generic/tclNotify.c index e5a438f..de60076 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.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: tclNotify.c,v 1.16 2004/11/30 19:34:49 dgp Exp $ + * RCS: @(#) $Id: tclNotify.c,v 1.16.2.1 2005/05/05 17:56:08 kennykb Exp $ */ #include "tclInt.h" @@ -67,6 +67,7 @@ typedef struct ThreadSpecificData { Tcl_ThreadId threadId; /* Thread that owns this notifier instance. */ ClientData clientData; /* Opaque handle for platform specific * notifier. */ + int initialized; /* 1 if notifier has been initialized. */ struct ThreadSpecificData *nextPtr; /* Next notifier in global list of notifiers. * Access is controlled by the listLock global @@ -124,6 +125,7 @@ TclInitNotifier() tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->threadId = threadId; tsdPtr->clientData = tclStubs.tcl_InitNotifier(); + tsdPtr->initialized = 1; tsdPtr->nextPtr = firstNotifierPtr; firstNotifierPtr = tsdPtr; } @@ -163,7 +165,7 @@ TclFinalizeNotifier() ThreadSpecificData **prevPtrPtr; Tcl_Event *evPtr, *hold; - if (tsdPtr->threadId == (Tcl_ThreadId)0) { + if (!tsdPtr->initialized) { return; /* Notifier not initialized for the current thread */ } @@ -190,6 +192,7 @@ TclFinalizeNotifier() break; } } + tsdPtr->initialized = 0; Tcl_MutexUnlock(&listLock); } diff --git a/generic/tclParse.c b/generic/tclParse.c index 2a5f3ef..0b5463c 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParse.c,v 1.39.2.1 2005/04/10 23:14:55 kennykb Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.39.2.2 2005/05/05 17:56:08 kennykb Exp $ */ #include "tclInt.h" @@ -243,11 +243,11 @@ TclParseInit(interp, string, numBytes, parsePtr) */ int -Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) +Tcl_ParseCommand(interp, start, numBytes, nested, parsePtr) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - CONST char *string; /* First character of string containing + CONST char *start; /* First character of string containing * one or more Tcl commands. */ register int numBytes; /* Total number of bytes in string. If < 0, * the script consists of all bytes up to @@ -273,16 +273,16 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) * point to char after terminating one. */ int scanned; - if ((string == NULL) && (numBytes>0)) { + if ((start == NULL) && (numBytes>0)) { if (interp != NULL) { Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC); } return TCL_ERROR; } if (numBytes < 0) { - numBytes = strlen(string); + numBytes = strlen(start); } - TclParseInit(interp, string, numBytes, parsePtr); + TclParseInit(interp, start, numBytes, parsePtr); parsePtr->commentStart = NULL; parsePtr->commentSize = 0; parsePtr->commandStart = NULL; @@ -298,8 +298,8 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) * command. */ - scanned = ParseComment(string, numBytes, parsePtr); - src = (string + scanned); numBytes -= scanned; + scanned = ParseComment(start, numBytes, parsePtr); + src = (start + scanned); numBytes -= scanned; if (numBytes == 0) { if (nested) { parsePtr->incomplete = nested; @@ -1148,12 +1148,12 @@ TclExpandTokenArray(parsePtr) */ int -Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) +Tcl_ParseVarName(interp, start, numBytes, parsePtr, append) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - CONST char *string; /* String containing variable name. First - * character must be "$". */ + CONST char *start; /* Start of variable substitution string. + * First character must be "$". */ register int numBytes; /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ @@ -1171,15 +1171,15 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) Tcl_UniChar ch; unsigned array; - if ((numBytes == 0) || (string == NULL)) { + if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } if (numBytes < 0) { - numBytes = strlen(string); + numBytes = strlen(start); } if (!append) { - TclParseInit(interp, string, numBytes, parsePtr); + TclParseInit(interp, start, numBytes, parsePtr); } /* @@ -1188,7 +1188,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) * there is one. */ - src = string; + src = start; if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) { TclExpandTokenArray(parsePtr); } @@ -1354,9 +1354,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) */ CONST char * -Tcl_ParseVar(interp, string, termPtr) +Tcl_ParseVar(interp, start, termPtr) Tcl_Interp *interp; /* Context for looking up variable. */ - register CONST char *string; /* String containing variable name. + register CONST char *start; /* Start of variable substitution. * First character must be "$". */ CONST char **termPtr; /* If non-NULL, points to word to fill * in with character just after last @@ -1367,12 +1367,12 @@ Tcl_ParseVar(interp, string, termPtr) register Tcl_Obj *objPtr; int code; - if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) { + if (Tcl_ParseVarName(interp, start, -1, &parse, 0) != TCL_OK) { return NULL; } if (termPtr != NULL) { - *termPtr = string + parse.tokenPtr->size; + *termPtr = start + parse.tokenPtr->size; } if (parse.numTokens == 1) { /* @@ -1436,12 +1436,12 @@ Tcl_ParseVar(interp, string, termPtr) */ int -Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) +Tcl_ParseBraces(interp, start, numBytes, parsePtr, append, termPtr) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - CONST char *string; /* String containing the string in braces. - * The first character must be '{'. */ + CONST char *start; /* Start of string enclosed in braces. + * The first character must be {'. */ register int numBytes; /* Total number of bytes in string. If < 0, * the string consists of all bytes up to * the first null character. */ @@ -1462,18 +1462,18 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) register CONST char *src; int startIndex, level, length; - if ((numBytes == 0) || (string == NULL)) { + if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } if (numBytes < 0) { - numBytes = strlen(string); + numBytes = strlen(start); } if (!append) { - TclParseInit(interp, string, numBytes, parsePtr); + TclParseInit(interp, start, numBytes, parsePtr); } - src = string; + src = start; startIndex = parsePtr->numTokens; if (parsePtr->numTokens == parsePtr->tokensAvailable) { @@ -1494,7 +1494,7 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) register int openBrace = 0; parsePtr->errorType = TCL_PARSE_MISSING_BRACE; - parsePtr->term = string; + parsePtr->term = start; parsePtr->incomplete = 1; if (interp == NULL) { /* @@ -1514,7 +1514,7 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) * by a '<whitespace>#' on the same line. */ - for (; src > string; src--) { + for (; src > start; src--) { switch (*src) { case '{': openBrace = 1; @@ -1640,11 +1640,11 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) */ int -Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) +Tcl_ParseQuotedString(interp, start, numBytes, parsePtr, append, termPtr) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - CONST char *string; /* String containing the quoted string. + CONST char *start; /* Start of the quoted string. * The first character must be '"'. */ register int numBytes; /* Total number of bytes in string. If < 0, * the string consists of all bytes up to @@ -1661,18 +1661,18 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) * after the quoted string's terminating * close-quote if the parse succeeds. */ { - if ((numBytes == 0) || (string == NULL)) { + if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } if (numBytes < 0) { - numBytes = strlen(string); + numBytes = strlen(start); } if (!append) { - TclParseInit(interp, string, numBytes, parsePtr); + TclParseInit(interp, start, numBytes, parsePtr); } - if (TCL_OK != ParseTokens(string+1, numBytes-1, TYPE_QUOTE, + if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL, parsePtr)) { goto error; } @@ -1681,7 +1681,7 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC); } parsePtr->errorType = TCL_PARSE_MISSING_QUOTE; - parsePtr->term = string; + parsePtr->term = start; parsePtr->incomplete = 1; goto error; } diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c index eb7f80c..8375b78 100644 --- a/generic/tclParseExpr.c +++ b/generic/tclParseExpr.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParseExpr.c,v 1.23.2.6 2005/03/15 19:41:45 kennykb Exp $ + * RCS: @(#) $Id: tclParseExpr.c,v 1.23.2.7 2005/05/05 17:56:09 kennykb Exp $ */ #include "tclInt.h" @@ -205,7 +205,7 @@ static void PrependSubExprTokens _ANSI_ARGS_((CONST char *op, * Given a string, this procedure parses the first Tcl expression * in the string and returns information about the structure of * the expression. This procedure is the top-level interface to the - * the expression parsing module. No more that numBytes bytes will + * the expression parsing module. No more than numBytes bytes will * be scanned. * * Results: @@ -226,9 +226,9 @@ static void PrependSubExprTokens _ANSI_ARGS_((CONST char *op, */ int -Tcl_ParseExpr(interp, string, numBytes, parsePtr) +Tcl_ParseExpr(interp, start, numBytes, parsePtr) Tcl_Interp *interp; /* Used for error reporting. */ - CONST char *string; /* The source string to parse. */ + CONST char *start; /* Start of source string to parse. */ int numBytes; /* Number of bytes in string. If < 0, the * string consists of all bytes up to the * first null character. */ @@ -241,16 +241,16 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr) int code; if (numBytes < 0) { - numBytes = (string? strlen(string) : 0); + numBytes = (start? strlen(start) : 0); } #ifdef TCL_COMPILE_DEBUG if (traceParseExpr) { fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n", - numBytes, string); + numBytes, start); } #endif /* TCL_COMPILE_DEBUG */ - TclParseInit(interp, string, numBytes, parsePtr); + TclParseInit(interp, start, numBytes, parsePtr); /* * Initialize the ParseInfo structure that holds state while parsing @@ -261,10 +261,10 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr) info.lexeme = UNKNOWN; info.start = NULL; info.size = 0; - info.next = string; - info.prevEnd = string; - info.originalExpr = string; - info.lastChar = (string + numBytes); /* just after last char of expr */ + info.next = start; + info.prevEnd = start; + info.originalExpr = start; + info.lastChar = (start + numBytes); /* just after last char of expr */ /* * Get the first lexeme then parse the expression. diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 1909ed6..1ec55d2 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclRegexp.c,v 1.17 2004/09/29 22:23:25 dkf Exp $ + * RCS: @(#) $Id: tclRegexp.c,v 1.17.2.1 2005/05/05 17:56:10 kennykb Exp $ */ #include "tclInt.h" @@ -137,13 +137,13 @@ Tcl_ObjType tclRegexpType = { */ Tcl_RegExp -Tcl_RegExpCompile(interp, string) +Tcl_RegExpCompile(interp, pattern) Tcl_Interp *interp; /* For use in error reporting and * to access the interp regexp cache. */ - CONST char *string; /* String for which to produce + CONST char *pattern; /* String for which to produce * compiled regular expression. */ { - return (Tcl_RegExp) CompileRegexp(interp, string, (int) strlen(string), + return (Tcl_RegExp) CompileRegexp(interp, pattern, (int) strlen(pattern), REG_ADVANCED); } @@ -169,13 +169,13 @@ Tcl_RegExpCompile(interp, string) */ int -Tcl_RegExpExec(interp, re, string, start) +Tcl_RegExpExec(interp, re, text, start) Tcl_Interp *interp; /* Interpreter to use for error reporting. */ Tcl_RegExp re; /* Compiled regular expression; must have * been returned by previous call to * Tcl_GetRegExpFromObj. */ - CONST char *string; /* String against which to match re. */ - CONST char *start; /* If string is part of a larger string, + CONST char *text; /* Text against which to match re. */ + CONST char *start; /* If text is part of a larger string, * this identifies beginning of larger * string, so that "^" won't match. */ { @@ -189,7 +189,7 @@ Tcl_RegExpExec(interp, re, string, start) * then we need to tell the regexp engine not to match "^". */ - if (string > start) { + if (text > start) { flags = REG_NOTBOL; } else { flags = 0; @@ -199,7 +199,7 @@ Tcl_RegExpExec(interp, re, string, start) * Remember the string for use by Tcl_RegExpRange(). */ - regexp->string = string; + regexp->string = text; regexp->objPtr = NULL; /* @@ -207,7 +207,7 @@ Tcl_RegExpExec(interp, re, string, start) */ Tcl_DStringInit(&ds); - ustr = Tcl_UtfToUniCharDString(string, -1, &ds); + ustr = Tcl_UtfToUniCharDString(text, -1, &ds); numChars = Tcl_DStringLength(&ds) / sizeof(Tcl_UniChar); result = RegExpExecUniChar(interp, re, ustr, numChars, -1 /* nmatches */, flags); @@ -385,7 +385,7 @@ TclRegExpRangeUniChar(re, index, startPtr, endPtr) * Results: * If an error occurs during the matching operation then -1 * is returned and the interp's result contains an error message. - * Otherwise the return value is 1 if "string" matches "pattern" + * Otherwise the return value is 1 if "text" matches "pattern" * and 0 otherwise. * * Side effects: @@ -395,11 +395,10 @@ TclRegExpRangeUniChar(re, index, startPtr, endPtr) */ int -Tcl_RegExpMatch(interp, string, pattern) +Tcl_RegExpMatch(interp, text, pattern) Tcl_Interp *interp; /* Used for error reporting. May be NULL. */ - CONST char *string; /* String. */ - CONST char *pattern; /* Regular expression to match against - * string. */ + CONST char *text; /* Text to search for pattern matches. */ + CONST char *pattern; /* Regular expression to match against text. */ { Tcl_RegExp re; @@ -407,7 +406,7 @@ Tcl_RegExpMatch(interp, string, pattern) if (re == NULL) { return -1; } - return Tcl_RegExpExec(interp, re, string, string); + return Tcl_RegExpExec(interp, re, text, text); } /* @@ -430,12 +429,12 @@ Tcl_RegExpMatch(interp, string, pattern) */ int -Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags) +Tcl_RegExpExecObj(interp, re, textObj, offset, nmatches, flags) Tcl_Interp *interp; /* Interpreter to use for error reporting. */ Tcl_RegExp re; /* Compiled regular expression; must have * been returned by previous call to * Tcl_GetRegExpFromObj. */ - Tcl_Obj *objPtr; /* String against which to match re. */ + Tcl_Obj *textObj; /* Text against which to match re. */ int offset; /* Character index that marks where matching * should begin. */ int nmatches; /* How many subexpression matches (counting @@ -452,9 +451,9 @@ Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags) */ regexpPtr->string = NULL; - regexpPtr->objPtr = objPtr; + regexpPtr->objPtr = textObj; - udata = Tcl_GetUnicodeFromObj(objPtr, &length); + udata = Tcl_GetUnicodeFromObj(textObj, &length); if (offset > length) { offset = length; @@ -475,7 +474,7 @@ Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags) * Results: * If an error occurs during the matching operation then -1 * is returned and the interp's result contains an error message. - * Otherwise the return value is 1 if "string" matches "pattern" + * Otherwise the return value is 1 if "text" matches "pattern" * and 0 otherwise. * * Side effects: @@ -485,9 +484,9 @@ Tcl_RegExpExecObj(interp, re, objPtr, offset, nmatches, flags) */ int -Tcl_RegExpMatchObj(interp, stringObj, patternObj) +Tcl_RegExpMatchObj(interp, textObj, patternObj) Tcl_Interp *interp; /* Used for error reporting. May be NULL. */ - Tcl_Obj *stringObj; /* Object containing the String to search. */ + Tcl_Obj *textObj; /* Object containing the String to search. */ Tcl_Obj *patternObj; /* Regular expression to match against * string. */ { @@ -498,7 +497,7 @@ Tcl_RegExpMatchObj(interp, stringObj, patternObj) if (re == NULL) { return -1; } - return Tcl_RegExpExecObj(interp, re, stringObj, 0 /* offset */, + return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */, 0 /* nmatches */, 0 /* flags */); } diff --git a/generic/tclResult.c b/generic/tclResult.c index 28f994d..ab35df4 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.23 2004/11/23 00:12:57 dkf Exp $ + * RCS: @(#) $Id: tclResult.c,v 1.23.2.1 2005/05/05 17:56:10 kennykb Exp $ */ #include "tclInt.h" @@ -381,23 +381,23 @@ Tcl_DiscardResult(statePtr) * * Tcl_SetResult -- * - * Arrange for "string" to be the Tcl return value. + * Arrange for "result" to be the Tcl return value. * * Results: * None. * * Side effects: - * interp->result is left pointing either to "string" (if "copy" is 0) - * or to a copy of string. Also, the object result is reset. + * interp->result is left pointing either to "result" + * or to a copy of it. Also, the object result is reset. * *---------------------------------------------------------------------- */ void -Tcl_SetResult(interp, stringPtr, freeProc) +Tcl_SetResult(interp, result, freeProc) Tcl_Interp *interp; /* Interpreter with which to associate the * return value. */ - register char *stringPtr; /* Value to be returned. If NULL, the + register char *result; /* Value to be returned. If NULL, the * result is set to an empty string. */ Tcl_FreeProc *freeProc; /* Gives information about the string: * TCL_STATIC, TCL_VOLATILE, or the address @@ -408,12 +408,12 @@ Tcl_SetResult(interp, stringPtr, freeProc) register Tcl_FreeProc *oldFreeProc = iPtr->freeProc; char *oldResult = iPtr->result; - if (stringPtr == NULL) { + if (result == NULL) { iPtr->resultSpace[0] = 0; iPtr->result = iPtr->resultSpace; iPtr->freeProc = 0; } else if (freeProc == TCL_VOLATILE) { - length = strlen(stringPtr); + length = strlen(result); if (length > TCL_RESULT_SIZE) { iPtr->result = (char *) ckalloc((unsigned) length+1); iPtr->freeProc = TCL_DYNAMIC; @@ -421,9 +421,9 @@ Tcl_SetResult(interp, stringPtr, freeProc) iPtr->result = iPtr->resultSpace; iPtr->freeProc = 0; } - strcpy(iPtr->result, stringPtr); + strcpy(iPtr->result, result); } else { - iPtr->result = stringPtr; + iPtr->result = result; iPtr->freeProc = freeProc; } @@ -706,10 +706,10 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1) */ void -Tcl_AppendElement(interp, stringPtr) +Tcl_AppendElement(interp, element) Tcl_Interp *interp; /* Interpreter whose result is to be * extended. */ - CONST char *stringPtr; /* String to convert to list element and + CONST char *element; /* String to convert to list element and * add to result. */ { Interp *iPtr = (Interp *) interp; @@ -729,7 +729,7 @@ Tcl_AppendElement(interp, stringPtr) * needed to accommodate the list element. */ - size = Tcl_ScanElement(stringPtr, &flags) + 1; + size = Tcl_ScanElement(element, &flags) + 1; if ((iPtr->result != iPtr->appendResult) || (iPtr->appendResult[iPtr->appendUsed] != 0) || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) { @@ -753,7 +753,7 @@ Tcl_AppendElement(interp, stringPtr) */ flags |= TCL_DONT_QUOTE_HASH; } - iPtr->appendUsed += Tcl_ConvertElement(stringPtr, dst, flags); + iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags); } /* diff --git a/generic/tclUtf.c b/generic/tclUtf.c index f0acdd2..6b7029c 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.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: tclUtf.c,v 1.32 2003/10/08 14:24:41 dkf Exp $ + * RCS: @(#) $Id: tclUtf.c,v 1.32.2.1 2005/05/05 17:56:11 kennykb Exp $ */ #include "tclInt.h" @@ -157,54 +157,54 @@ UtfCount(ch) */ INLINE int -Tcl_UniCharToUtf(ch, str) +Tcl_UniCharToUtf(ch, buf) int ch; /* The Tcl_UniChar to be stored in the * buffer. */ - char *str; /* Buffer in which the UTF-8 representation + char *buf; /* Buffer in which the UTF-8 representation * of the Tcl_UniChar is stored. Buffer must * be large enough to hold the UTF-8 character * (at most TCL_UTF_MAX bytes). */ { if ((ch > 0) && (ch < UNICODE_SELF)) { - str[0] = (char) ch; + buf[0] = (char) ch; return 1; } if (ch <= 0x7FF) { - str[1] = (char) ((ch | 0x80) & 0xBF); - str[0] = (char) ((ch >> 6) | 0xC0); + buf[1] = (char) ((ch | 0x80) & 0xBF); + buf[0] = (char) ((ch >> 6) | 0xC0); return 2; } if (ch <= 0xFFFF) { three: - str[2] = (char) ((ch | 0x80) & 0xBF); - str[1] = (char) (((ch >> 6) | 0x80) & 0xBF); - str[0] = (char) ((ch >> 12) | 0xE0); + buf[2] = (char) ((ch | 0x80) & 0xBF); + buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF); + buf[0] = (char) ((ch >> 12) | 0xE0); return 3; } #if TCL_UTF_MAX > 3 if (ch <= 0x1FFFFF) { - str[3] = (char) ((ch | 0x80) & 0xBF); - str[2] = (char) (((ch >> 6) | 0x80) & 0xBF); - str[1] = (char) (((ch >> 12) | 0x80) & 0xBF); - str[0] = (char) ((ch >> 18) | 0xF0); + buf[3] = (char) ((ch | 0x80) & 0xBF); + buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF); + buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF); + buf[0] = (char) ((ch >> 18) | 0xF0); return 4; } if (ch <= 0x3FFFFFF) { - str[4] = (char) ((ch | 0x80) & 0xBF); - str[3] = (char) (((ch >> 6) | 0x80) & 0xBF); - str[2] = (char) (((ch >> 12) | 0x80) & 0xBF); - str[1] = (char) (((ch >> 18) | 0x80) & 0xBF); - str[0] = (char) ((ch >> 24) | 0xF8); + buf[4] = (char) ((ch | 0x80) & 0xBF); + buf[3] = (char) (((ch >> 6) | 0x80) & 0xBF); + buf[2] = (char) (((ch >> 12) | 0x80) & 0xBF); + buf[1] = (char) (((ch >> 18) | 0x80) & 0xBF); + buf[0] = (char) ((ch >> 24) | 0xF8); return 5; } if (ch <= 0x7FFFFFFF) { - str[5] = (char) ((ch | 0x80) & 0xBF); - str[4] = (char) (((ch >> 6) | 0x80) & 0xBF); - str[3] = (char) (((ch >> 12) | 0x80) & 0xBF); - str[2] = (char) (((ch >> 18) | 0x80) & 0xBF); - str[1] = (char) (((ch >> 24) | 0x80) & 0xBF); - str[0] = (char) ((ch >> 30) | 0xFC); + buf[5] = (char) ((ch | 0x80) & 0xBF); + buf[4] = (char) (((ch >> 6) | 0x80) & 0xBF); + buf[3] = (char) (((ch >> 12) | 0x80) & 0xBF); + buf[2] = (char) (((ch >> 18) | 0x80) & 0xBF); + buf[1] = (char) (((ch >> 24) | 0x80) & 0xBF); + buf[0] = (char) ((ch >> 30) | 0xFC); return 6; } #endif @@ -232,9 +232,9 @@ Tcl_UniCharToUtf(ch, str) */ char * -Tcl_UniCharToUtfDString(wString, numChars, dsPtr) - CONST Tcl_UniChar *wString; /* Unicode string to convert to UTF-8. */ - int numChars; /* Length of Unicode string in Tcl_UniChars +Tcl_UniCharToUtfDString(uniStr, uniLength, dsPtr) + CONST Tcl_UniChar *uniStr; /* Unicode string to convert to UTF-8. */ + int uniLength; /* Length of Unicode string in Tcl_UniChars * (must be >= 0). */ Tcl_DString *dsPtr; /* UTF-8 representation of string is * appended to this previously initialized @@ -250,12 +250,12 @@ Tcl_UniCharToUtfDString(wString, numChars, dsPtr) */ oldLength = Tcl_DStringLength(dsPtr); - Tcl_DStringSetLength(dsPtr, (oldLength + numChars + 1) * TCL_UTF_MAX); + Tcl_DStringSetLength(dsPtr, (oldLength + uniLength + 1) * TCL_UTF_MAX); string = Tcl_DStringValue(dsPtr) + oldLength; p = string; - wEnd = wString + numChars; - for (w = wString; w < wEnd; ) { + wEnd = uniStr + uniLength; + for (w = uniStr; w < wEnd; ) { p += Tcl_UniCharToUtf(*w, p); w++; } @@ -291,8 +291,8 @@ Tcl_UniCharToUtfDString(wString, numChars, dsPtr) */ int -Tcl_UtfToUniChar(str, chPtr) - register CONST char *str; /* The UTF-8 string. */ +Tcl_UtfToUniChar(src, chPtr) + register CONST char *src; /* The UTF-8 string. */ register Tcl_UniChar *chPtr; /* Filled with the Tcl_UniChar represented * by the UTF-8 string. */ { @@ -302,7 +302,7 @@ Tcl_UtfToUniChar(str, chPtr) * Unroll 1 to 3 byte UTF-8 sequences, use loop to handle longer ones. */ - byte = *((unsigned char *) str); + byte = *((unsigned char *) src); if (byte < 0xC0) { /* * Handles properly formed UTF-8 characters between 0x01 and 0x7F. @@ -313,12 +313,12 @@ Tcl_UtfToUniChar(str, chPtr) *chPtr = (Tcl_UniChar) byte; return 1; } else if (byte < 0xE0) { - if ((str[1] & 0xC0) == 0x80) { + if ((src[1] & 0xC0) == 0x80) { /* * Two-byte-character lead-byte followed by a trail-byte. */ - *chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (str[1] & 0x3F)); + *chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (src[1] & 0x3F)); return 2; } /* @@ -329,13 +329,13 @@ Tcl_UtfToUniChar(str, chPtr) *chPtr = (Tcl_UniChar) byte; return 1; } else if (byte < 0xF0) { - if (((str[1] & 0xC0) == 0x80) && ((str[2] & 0xC0) == 0x80)) { + if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) { /* * Three-byte-character lead byte followed by two trail bytes. */ *chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12) - | ((str[1] & 0x3F) << 6) | (str[2] & 0x3F)); + | ((src[1] & 0x3F) << 6) | (src[2] & 0x3F)); return 3; } /* @@ -355,13 +355,13 @@ Tcl_UtfToUniChar(str, chPtr) if (trail > 0) { ch = byte & (0x3F >> trail); do { - str++; - if ((*str & 0xC0) != 0x80) { + src++; + if ((*src & 0xC0) != 0x80) { *chPtr = byte; return 1; } ch <<= 6; - ch |= (*str & 0x3F); + ch |= (*src & 0x3F); trail--; } while (trail > 0); *chPtr = ch; @@ -394,8 +394,8 @@ Tcl_UtfToUniChar(str, chPtr) */ Tcl_UniChar * -Tcl_UtfToUniCharDString(string, length, dsPtr) - CONST char *string; /* UTF-8 string to convert to Unicode. */ +Tcl_UtfToUniCharDString(src, length, dsPtr) + CONST char *src; /* UTF-8 string to convert to Unicode. */ int length; /* Length of UTF-8 string in bytes, or -1 * for strlen(). */ Tcl_DString *dsPtr; /* Unicode representation of string is @@ -407,7 +407,7 @@ Tcl_UtfToUniCharDString(string, length, dsPtr) int oldLength; if (length < 0) { - length = strlen(string); + length = strlen(src); } /* @@ -421,8 +421,8 @@ Tcl_UtfToUniCharDString(string, length, dsPtr) wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength); w = wString; - end = string + length; - for (p = string; p < end; ) { + end = src + length; + for (p = src; p < end; ) { p += TclUtfToUniChar(p, w); w++; } @@ -453,15 +453,15 @@ Tcl_UtfToUniCharDString(string, length, dsPtr) */ int -Tcl_UtfCharComplete(str, len) - CONST char *str; /* String to check if first few bytes +Tcl_UtfCharComplete(src, length) + CONST char *src; /* String to check if first few bytes * contain a complete UTF-8 character. */ - int len; /* Length of above string in bytes. */ + int length; /* Length of above string in bytes. */ { int ch; - ch = *((unsigned char *) str); - return len >= totalBytes[ch]; + ch = *((unsigned char *) src); + return length >= totalBytes[ch]; } /* @@ -483,9 +483,9 @@ Tcl_UtfCharComplete(str, len) */ int -Tcl_NumUtfChars(str, len) - register CONST char *str; /* The UTF-8 string to measure. */ - int len; /* The length of the string in bytes, or -1 +Tcl_NumUtfChars(src, length) + register CONST char *src; /* The UTF-8 string to measure. */ + int length; /* The length of the string in bytes, or -1 * for strlen(string). */ { Tcl_UniChar ch; @@ -500,22 +500,22 @@ Tcl_NumUtfChars(str, len) */ i = 0; - if (len < 0) { - while (*str != '\0') { - str += TclUtfToUniChar(str, chPtr); + if (length < 0) { + while (*src != '\0') { + src += TclUtfToUniChar(src, chPtr); i++; } } else { register int n; - while (len > 0) { - if (UCHAR(*str) < 0xC0) { - len--; - str++; + while (length > 0) { + if (UCHAR(*src) < 0xC0) { + length--; + src++; } else { - n = Tcl_UtfToUniChar(str, chPtr); - len -= n; - str += n; + n = Tcl_UtfToUniChar(src, chPtr); + length -= n; + src += n; } i++; } @@ -543,22 +543,22 @@ Tcl_NumUtfChars(str, len) *--------------------------------------------------------------------------- */ CONST char * -Tcl_UtfFindFirst(string, ch) - CONST char *string; /* The UTF-8 string to be searched. */ +Tcl_UtfFindFirst(src, ch) + CONST char *src; /* The UTF-8 string to be searched. */ int ch; /* The Tcl_UniChar to search for. */ { int len; Tcl_UniChar find; while (1) { - len = TclUtfToUniChar(string, &find); + len = TclUtfToUniChar(src, &find); if (find == ch) { - return string; + return src; } - if (*string == '\0') { + if (*src == '\0') { return NULL; } - string += len; + src += len; } } @@ -583,8 +583,8 @@ Tcl_UtfFindFirst(string, ch) */ CONST char * -Tcl_UtfFindLast(string, ch) - CONST char *string; /* The UTF-8 string to be searched. */ +Tcl_UtfFindLast(src, ch) + CONST char *src; /* The UTF-8 string to be searched. */ int ch; /* The Tcl_UniChar to search for. */ { int len; @@ -593,14 +593,14 @@ Tcl_UtfFindLast(string, ch) last = NULL; while (1) { - len = TclUtfToUniChar(string, &find); + len = TclUtfToUniChar(src, &find); if (find == ch) { - last = string; + last = src; } - if (*string == '\0') { + if (*src == '\0') { break; } - string += len; + src += len; } return last; } @@ -626,12 +626,12 @@ Tcl_UtfFindLast(string, ch) */ CONST char * -Tcl_UtfNext(str) - CONST char *str; /* The current location in the string. */ +Tcl_UtfNext(src) + CONST char *src; /* The current location in the string. */ { Tcl_UniChar ch; - return str + TclUtfToUniChar(str, &ch); + return src + TclUtfToUniChar(src, &ch); } /* @@ -656,8 +656,8 @@ Tcl_UtfNext(str) */ CONST char * -Tcl_UtfPrev(str, start) - CONST char *str; /* The current location in the string. */ +Tcl_UtfPrev(src, start) + CONST char *src; /* The current location in the string. */ CONST char *start; /* Pointer to the beginning of the * string, to avoid going backwards too * far. */ @@ -665,12 +665,12 @@ Tcl_UtfPrev(str, start) CONST char *look; int i, byte; - str--; - look = str; + src--; + look = src; for (i = 0; i < TCL_UTF_MAX; i++) { if (look < start) { - if (str < start) { - str = start; + if (src < start) { + src = start; } break; } @@ -683,7 +683,7 @@ Tcl_UtfPrev(str, start) } look--; } - return str; + return src; } /* @@ -1017,8 +1017,8 @@ TclpUtfNcmp2(cs, ct, n) * * Tcl_UtfNcmp -- * - * Compare at most n UTF chars of string cs to string ct. Both cs - * and ct are assumed to be at least n UTF chars long. + * Compare at most numChars UTF chars of string cs to string ct. + * Both cs and ct are assumed to be at least numChars UTF chars long. * * Results: * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. @@ -1030,10 +1030,10 @@ TclpUtfNcmp2(cs, ct, n) */ int -Tcl_UtfNcmp(cs, ct, n) +Tcl_UtfNcmp(cs, ct, numChars) CONST char *cs; /* UTF string to compare to ct. */ CONST char *ct; /* UTF string cs is compared to. */ - unsigned long n; /* Number of UTF chars to compare. */ + unsigned long numChars; /* Number of UTF chars to compare. */ { Tcl_UniChar ch1, ch2; /* @@ -1041,7 +1041,7 @@ Tcl_UtfNcmp(cs, ct, n) * \u0000 (the pair of bytes 0xc0,0x80) is larger than byte * representation of \u0001 (the byte 0x01.) */ - while (n-- > 0) { + while (numChars-- > 0) { /* * n must be interpreted as chars, not bytes. * This should be called only when both strings are of @@ -1061,8 +1061,8 @@ Tcl_UtfNcmp(cs, ct, n) * * Tcl_UtfNcasecmp -- * - * Compare at most n UTF chars of string cs to string ct case - * insensitive. Both cs and ct are assumed to be at least n + * Compare at most numChars UTF chars of string cs to string ct case + * insensitive. Both cs and ct are assumed to be at least numChars * UTF chars long. * * Results: @@ -1075,13 +1075,13 @@ Tcl_UtfNcmp(cs, ct, n) */ int -Tcl_UtfNcasecmp(cs, ct, n) +Tcl_UtfNcasecmp(cs, ct, numChars) CONST char *cs; /* UTF string to compare to ct. */ CONST char *ct; /* UTF string cs is compared to. */ - unsigned long n; /* Number of UTF chars to compare. */ + unsigned long numChars; /* Number of UTF chars to compare. */ { Tcl_UniChar ch1, ch2; - while (n-- > 0) { + while (numChars-- > 0) { /* * n must be interpreted as chars, not bytes. * This should be called only when both strings are of @@ -1212,14 +1212,14 @@ Tcl_UniCharToTitle(ch) */ int -Tcl_UniCharLen(str) - CONST Tcl_UniChar *str; /* Unicode string to find length of. */ +Tcl_UniCharLen(uniStr) + CONST Tcl_UniChar *uniStr; /* Unicode string to find length of. */ { int len = 0; - while (*str != '\0') { + while (*uniStr != '\0') { len++; - str++; + uniStr++; } return len; } @@ -1229,11 +1229,11 @@ Tcl_UniCharLen(str) * * Tcl_UniCharNcmp -- * - * Compare at most n unichars of string cs to string ct. Both cs - * and ct are assumed to be at least n unichars long. + * Compare at most numChars unichars of string ucs to string uct. + * Both ucs and uct are assumed to be at least numChars unichars long. * * Results: - * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. + * Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct. * * Side effects: * None. @@ -1242,24 +1242,24 @@ Tcl_UniCharLen(str) */ int -Tcl_UniCharNcmp(cs, ct, n) - CONST Tcl_UniChar *cs; /* Unicode string to compare to ct. */ - CONST Tcl_UniChar *ct; /* Unicode string cs is compared to. */ - unsigned long n; /* Number of unichars to compare. */ +Tcl_UniCharNcmp(ucs, uct, numChars) + CONST Tcl_UniChar *ucs; /* Unicode string to compare to uct. */ + CONST Tcl_UniChar *uct; /* Unicode string ucs is compared to. */ + unsigned long numChars; /* Number of unichars to compare. */ { #ifdef WORDS_BIGENDIAN /* * We are definitely on a big-endian machine; memcmp() is safe */ - return memcmp(cs, ct, n*sizeof(Tcl_UniChar)); + return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar)); #else /* !WORDS_BIGENDIAN */ /* * We can't simply call memcmp() because that is not lexically correct. */ - for ( ; n != 0; cs++, ct++, n--) { - if (*cs != *ct) { - return (*cs - *ct); + for ( ; numChars != 0; ucs++, uct++, numChars--) { + if (*ucs != *uct) { + return (*ucs - *uct); } } return 0; @@ -1271,12 +1271,12 @@ Tcl_UniCharNcmp(cs, ct, n) * * Tcl_UniCharNcasecmp -- * - * Compare at most n unichars of string cs to string ct case - * insensitive. Both cs and ct are assumed to be at least n + * Compare at most numChars unichars of string ucs to string uct case + * insensitive. Both ucs and uct are assumed to be at least numChars * unichars long. * * Results: - * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct. + * Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct. * * Side effects: * None. @@ -1285,15 +1285,15 @@ Tcl_UniCharNcmp(cs, ct, n) */ int -Tcl_UniCharNcasecmp(cs, ct, n) - CONST Tcl_UniChar *cs; /* Unicode string to compare to ct. */ - CONST Tcl_UniChar *ct; /* Unicode string cs is compared to. */ - unsigned long n; /* Number of unichars to compare. */ +Tcl_UniCharNcasecmp(ucs, uct, numChars) + CONST Tcl_UniChar *ucs; /* Unicode string to compare to uct. */ + CONST Tcl_UniChar *uct; /* Unicode string ucs is compared to. */ + unsigned long numChars; /* Number of unichars to compare. */ { - for ( ; n != 0; n--, cs++, ct++) { - if (*cs != *ct) { - Tcl_UniChar lcs = Tcl_UniCharToLower(*cs); - Tcl_UniChar lct = Tcl_UniCharToLower(*ct); + for ( ; numChars != 0; numChars--, ucs++, uct++) { + if (*ucs != *uct) { + Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs); + Tcl_UniChar lct = Tcl_UniCharToLower(*uct); if (lcs != lct) { return (lcs - lct); } @@ -1602,16 +1602,16 @@ Tcl_UniCharIsWordChar(ch) */ int -Tcl_UniCharCaseMatch(string, pattern, nocase) - CONST Tcl_UniChar *string; /* Unicode String. */ - CONST Tcl_UniChar *pattern; /* Pattern, which may contain special - * characters. */ +Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase) + CONST Tcl_UniChar *uniStr; /* Unicode String. */ + CONST Tcl_UniChar *uniPattern; /* Pattern, which may contain special + * characters. */ int nocase; /* 0 for case sensitive, 1 for insensitive */ { Tcl_UniChar ch1, p; while (1) { - p = *pattern; + p = *uniPattern; /* * See if we're at the end of both the pattern and the string. If @@ -1620,9 +1620,9 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) */ if (p == 0) { - return (*string == 0); + return (*uniStr == 0); } - if ((*string == 0) && (p != '*')) { + if ((*uniStr == 0) && (p != '*')) { return 0; } @@ -1638,8 +1638,8 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) /* * Skip all successive *'s in the pattern */ - while (*(++pattern) == '*') {} - p = *pattern; + while (*(++uniPattern) == '*') {} + p = *uniPattern; if (p == 0) { return 1; } @@ -1654,21 +1654,21 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { - while (*string && (p != *string) - && (p != Tcl_UniCharToLower(*string))) { - string++; + while (*uniStr && (p != *uniStr) + && (p != Tcl_UniCharToLower(*uniStr))) { + uniStr++; } } else { - while (*string && (p != *string)) { string++; } + while (*uniStr && (p != *uniStr)) { uniStr++; } } } - if (Tcl_UniCharCaseMatch(string, pattern, nocase)) { + if (Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)) { return 1; } - if (*string == 0) { + if (*uniStr == 0) { return 0; } - string++; + uniStr++; } } @@ -1678,8 +1678,8 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) */ if (p == '?') { - pattern++; - string++; + uniPattern++; + uniStr++; continue; } @@ -1692,23 +1692,23 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) if (p == '[') { Tcl_UniChar startChar, endChar; - pattern++; - ch1 = (nocase ? Tcl_UniCharToLower(*string) : *string); - string++; + uniPattern++; + ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr); + uniStr++; while (1) { - if ((*pattern == ']') || (*pattern == 0)) { + if ((*uniPattern == ']') || (*uniPattern == 0)) { return 0; } - startChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern); - pattern++; - if (*pattern == '-') { - pattern++; - if (*pattern == 0) { + startChar = (nocase ? Tcl_UniCharToLower(*uniPattern) : *uniPattern); + uniPattern++; + if (*uniPattern == '-') { + uniPattern++; + if (*uniPattern == 0) { return 0; } - endChar = (nocase ? Tcl_UniCharToLower(*pattern) - : *pattern); - pattern++; + endChar = (nocase ? Tcl_UniCharToLower(*uniPattern) + : *uniPattern); + uniPattern++; if (((startChar <= ch1) && (ch1 <= endChar)) || ((endChar <= ch1) && (ch1 <= startChar))) { /* @@ -1720,14 +1720,14 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) break; } } - while (*pattern != ']') { - if (*pattern == 0) { - pattern--; + while (*uniPattern != ']') { + if (*uniPattern == 0) { + uniPattern--; break; } - pattern++; + uniPattern++; } - pattern++; + uniPattern++; continue; } @@ -1737,7 +1737,7 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) */ if (p == '\\') { - if (*(++pattern) == '\0') { + if (*(++uniPattern) == '\0') { return 0; } } @@ -1748,14 +1748,14 @@ Tcl_UniCharCaseMatch(string, pattern, nocase) */ if (nocase) { - if (Tcl_UniCharToLower(*string) != Tcl_UniCharToLower(*pattern)) { + if (Tcl_UniCharToLower(*uniStr) != Tcl_UniCharToLower(*uniPattern)) { return 0; } - } else if (*string != *pattern) { + } else if (*uniStr != *uniPattern) { return 0; } - string++; - pattern++; + uniStr++; + uniPattern++; } } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 0d538e0..c00ac1e 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtil.c,v 1.51.2.10 2005/04/25 21:37:22 kennykb Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.51.2.11 2005/05/05 17:56:11 kennykb Exp $ */ #include "tclInt.h" @@ -1196,12 +1196,12 @@ Tcl_ConcatObj(objc, objv) */ int -Tcl_StringMatch(string, pattern) - CONST char *string; /* String. */ +Tcl_StringMatch(str, pattern) + CONST char *str; /* String. */ CONST char *pattern; /* Pattern, which may contain special * characters. */ { - return Tcl_StringCaseMatch(string, pattern, 0); + return Tcl_StringCaseMatch(str, pattern, 0); } /* @@ -1225,8 +1225,8 @@ Tcl_StringMatch(string, pattern) */ int -Tcl_StringCaseMatch(string, pattern, nocase) - CONST char *string; /* String. */ +Tcl_StringCaseMatch(str, pattern, nocase) + CONST char *str; /* String. */ CONST char *pattern; /* Pattern, which may contain special * characters. */ int nocase; /* 0 for case sensitive, 1 for insensitive */ @@ -1245,9 +1245,9 @@ Tcl_StringCaseMatch(string, pattern, nocase) */ if (p == '\0') { - return (*string == '\0'); + return (*str == '\0'); } - if ((*string == '\0') && (p != '*')) { + if ((*str == '\0') && (p != '*')) { return 0; } @@ -1287,12 +1287,12 @@ Tcl_StringCaseMatch(string, pattern, nocase) */ if ((p != '[') && (p != '?') && (p != '\\')) { if (nocase) { - while (*string) { - charLen = TclUtfToUniChar(string, &ch1); + while (*str) { + charLen = TclUtfToUniChar(str, &ch1); if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) { break; } - string += charLen; + str += charLen; } } else { /* @@ -1300,22 +1300,22 @@ Tcl_StringCaseMatch(string, pattern, nocase) * shorter, as the number of bytes you want to * compare each time is non-constant. */ - while (*string) { - charLen = TclUtfToUniChar(string, &ch1); + while (*str) { + charLen = TclUtfToUniChar(str, &ch1); if (ch2 == ch1) { break; } - string += charLen; + str += charLen; } } } - if (Tcl_StringCaseMatch(string, pattern, nocase)) { + if (Tcl_StringCaseMatch(str, pattern, nocase)) { return 1; } - if (*string == '\0') { + if (*str == '\0') { return 0; } - string += TclUtfToUniChar(string, &ch1); + str += TclUtfToUniChar(str, &ch1); } } @@ -1326,7 +1326,7 @@ Tcl_StringCaseMatch(string, pattern, nocase) if (p == '?') { pattern++; - string += TclUtfToUniChar(string, &ch1); + str += TclUtfToUniChar(str, &ch1); continue; } @@ -1340,12 +1340,12 @@ Tcl_StringCaseMatch(string, pattern, nocase) Tcl_UniChar startChar, endChar; pattern++; - if (UCHAR(*string) < 0x80) { + if (UCHAR(*str) < 0x80) { ch1 = (Tcl_UniChar) - (nocase ? tolower(UCHAR(*string)) : UCHAR(*string)); - string++; + (nocase ? tolower(UCHAR(*str)) : UCHAR(*str)); + str++; } else { - string += Tcl_UtfToUniChar(string, &ch1); + str += Tcl_UtfToUniChar(str, &ch1); if (nocase) { ch1 = Tcl_UniCharToLower(ch1); } @@ -1420,7 +1420,7 @@ Tcl_StringCaseMatch(string, pattern, nocase) * bytes of each string match. */ - string += TclUtfToUniChar(string, &ch1); + str += TclUtfToUniChar(str, &ch1); pattern += TclUtfToUniChar(pattern, &ch2); if (nocase) { if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) { @@ -1502,13 +1502,13 @@ Tcl_DStringInit(dsPtr) * * Tcl_DStringAppend -- * - * Append more characters to the current value of a dynamic string. + * Append more bytes to the current value of a dynamic string. * * Results: * The return value is a pointer to the dynamic string's new value. * * Side effects: - * Length bytes from string (or all of string if length is less + * Length bytes from "bytes" (or all of "bytes" if length is less * than zero) are added to the current value of the string. Memory * gets reallocated if needed to accomodate the string's new size. * @@ -1516,12 +1516,12 @@ Tcl_DStringInit(dsPtr) */ char * -Tcl_DStringAppend(dsPtr, string, length) +Tcl_DStringAppend(dsPtr, bytes, length) Tcl_DString *dsPtr; /* Structure describing dynamic string. */ - CONST char *string; /* String to append. If length is -1 then + CONST char *bytes; /* String to append. If length is -1 then * this must be null-terminated. */ - int length; /* Number of characters from string to - * append. If < 0, then append all of string, + int length; /* Number of bytes from "bytes" to + * append. If < 0, then append all of bytes, * up to null at end. */ { int newSize; @@ -1529,7 +1529,7 @@ Tcl_DStringAppend(dsPtr, string, length) CONST char *end; if (length < 0) { - length = strlen(string); + length = strlen(bytes); } newSize = length + dsPtr->length; @@ -1559,9 +1559,9 @@ Tcl_DStringAppend(dsPtr, string, length) * one. */ - for (dst = dsPtr->string + dsPtr->length, end = string+length; - string < end; string++, dst++) { - *dst = *string; + for (dst = dsPtr->string + dsPtr->length, end = bytes+length; + bytes < end; bytes++, dst++) { + *dst = *bytes; } *dst = '\0'; dsPtr->length += length; @@ -1587,16 +1587,16 @@ Tcl_DStringAppend(dsPtr, string, length) */ char * -Tcl_DStringAppendElement(dsPtr, string) +Tcl_DStringAppendElement(dsPtr, element) Tcl_DString *dsPtr; /* Structure describing dynamic string. */ - CONST char *string; /* String to append. Must be + CONST char *element; /* String to append. Must be * null-terminated. */ { int newSize, flags, strSize; char *dst; - strSize = ((string == NULL) ? 0 : strlen(string)); - newSize = Tcl_ScanCountedElement(string, strSize, &flags) + strSize = ((element== NULL) ? 0 : strlen(element)); + newSize = Tcl_ScanCountedElement(element, strSize, &flags) + dsPtr->length + 1; /* @@ -1640,7 +1640,7 @@ Tcl_DStringAppendElement(dsPtr, string) */ flags |= TCL_DONT_QUOTE_HASH; } - dsPtr->length += Tcl_ConvertCountedElement(string, strSize, dst, flags); + dsPtr->length += Tcl_ConvertCountedElement(element, strSize, dst, flags); return dsPtr->string; } @@ -2375,15 +2375,14 @@ TclLooksLikeInt(bytes, length) * * This procedure returns an integer corresponding to the list index * held in a Tcl object. The Tcl object's value is expected to be - * either an integer or a string of the form "end([+-]integer)?". + * in the format integer([+-]integer)? or the format end([+-]integer)?. * * Results: * The return value is normally TCL_OK, which means that the index was * successfully stored into the location referenced by "indexPtr". If * the Tcl object referenced by "objPtr" has the value "end", the - * value stored is "endValue". If "objPtr"s values is not of the form - * "end([+-]integer)?" and - * can not be converted to an integer, TCL_ERROR is returned and, if + * value stored is "endValue". If "objPtr"s values is not of one + * of the expected formats, TCL_ERROR is returned and, if * "interp" is non-NULL, an error message is left in the interpreter's * result object. * @@ -2419,10 +2418,51 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr) *indexPtr = endValue + objPtr->internalRep.longValue; } else { + int opIdx, length; + char *bytes = Tcl_GetStringFromObj(objPtr, &length); + char *p = bytes; + + while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */ + length--; p++; + } + if (length == 0) { + goto parseError; + } + if ((*p == '+') || (*p == '-')) { + p++; length--; + } + opIdx = TclParseInteger(p, length) + (int) (p-bytes); + if (opIdx) { + int code, first, second; + char savedOp = bytes[opIdx]; + if ((savedOp != '+') && (savedOp != '-')) { + goto parseError; + } + if (isspace(UCHAR(bytes[opIdx+1]))) { + goto parseError; + } + bytes[opIdx] = '\0'; + code = Tcl_GetInt(interp, bytes, &first); + bytes[opIdx] = savedOp; + if (code == TCL_ERROR) { + goto parseError; + } + if (TCL_ERROR == Tcl_GetInt(interp, bytes+opIdx+1, &second)) { + goto parseError; + } + if (savedOp == '+') { + *indexPtr = first + second; + } else { + *indexPtr = first - second; + } + return TCL_OK; + } + /* * Report a parse error. */ +parseError: if (interp != NULL) { char *bytes = Tcl_GetString(objPtr); /* @@ -2432,7 +2472,8 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr) */ Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be integer or end?-integer?", (char *) NULL); + "\": must be integer?[+-]integer? or end?[+-]integer?", + (char *) NULL); if (!strncmp(bytes, "end-", 3)) { bytes += 3; } @@ -2489,7 +2530,7 @@ UpdateStringOfEndOffset(objPtr) * * SetEndOffsetFromAny -- * - * Look for a string of the form "end-offset" and convert it + * Look for a string of the form "end[+-]offset" and convert it * to an internal representation holding the offset. * * Results: @@ -2525,7 +2566,7 @@ SetEndOffsetFromAny(interp, objPtr) if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be end?-integer?", (char*) NULL); + "\": must be end?[+-]integer?", (char*) NULL); } return TCL_ERROR; } @@ -2534,15 +2575,20 @@ SetEndOffsetFromAny(interp, objPtr) if (length <= 3) { offset = 0; - } else if ((length > 4) && (bytes[3] == '-')) { + } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) { /* * This is our limited string expression evaluator. Pass everything * after "end-" to Tcl_GetInt, then reverse for offset. */ + if (isspace(UCHAR(bytes[4]))) { + return TCL_ERROR; + } if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) { return TCL_ERROR; } - offset = -offset; + if (bytes[3] == '-') { + offset = -offset; + } } else { /* * Conversion failed. Report the error. @@ -2550,7 +2596,7 @@ SetEndOffsetFromAny(interp, objPtr) if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be integer or end?-integer?", (char *) NULL); + "\": must be end?[+-]integer?", (char *) NULL); } return TCL_ERROR; } |