From 7590c5df93387698c15ecc2d52c643032c605d54 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 13 Nov 2017 15:34:50 +0000 Subject: Add back Tcl_Backslash(). Will be removed again when TIP #485 is brought in. Also revert some other API changes (unsigned long -> size_t), for which TIP's are still to be written. --- doc/Eval.3 | 21 ++++++++++++++- generic/tcl.decls | 15 +++++------ generic/tclCmdMZ.c | 74 +++++++++++++++++++++++++-------------------------- generic/tclDecls.h | 27 +++++++++++-------- generic/tclInt.decls | 2 +- generic/tclIntDecls.h | 4 +-- generic/tclStubInit.c | 2 +- generic/tclUtf.c | 10 +++---- generic/tclUtil.c | 63 ++++++++++++++++++++++++++++++++++++++----- 9 files changed, 145 insertions(+), 73 deletions(-) diff --git a/doc/Eval.3 b/doc/Eval.3 index 89f557e..3936f5d 100644 --- a/doc/Eval.3 +++ b/doc/Eval.3 @@ -10,7 +10,7 @@ .so man.macros .BS .SH NAME -Tcl_EvalObjEx, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx \- execute Tcl scripts +Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx \- execute Tcl scripts .SH SYNOPSIS .nf \fB#include \fR @@ -19,6 +19,9 @@ int \fBTcl_EvalObjEx\fR(\fIinterp, objPtr, flags\fR) .sp int +\fBTcl_EvalFile\fR(\fIinterp, fileName\fR) +.sp +int \fBTcl_EvalObjv\fR(\fIinterp, objc, objv, flags\fR) .sp int @@ -78,6 +81,22 @@ integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. .PP +\fBTcl_EvalFile\fR reads the file given by \fIfileName\fR and evaluates +its contents as a Tcl script. It returns the same information as +\fBTcl_EvalObjEx\fR. +If the file could not be read then a Tcl error is returned to describe +why the file could not be read. +The eofchar for files is +.QW \e32 +(^Z) for all platforms. If you require a +.QW ^Z +in code for string comparison, you can use +.QW \e032 +or +.QW \eu001a , +which will be safely substituted by the Tcl interpreter into +.QW ^Z . +.PP \fBTcl_EvalObjv\fR executes a single pre-parsed command instead of a script. The \fIobjc\fR and \fIobjv\fR arguments contain the values of the words for the Tcl command, one word in each value in diff --git a/generic/tcl.decls b/generic/tcl.decls index c11bf38..54d1921 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -292,10 +292,9 @@ declare 75 { declare 76 { void Tcl_BackgroundError(Tcl_Interp *interp) } -# Removed in 9.0 -#declare 77 { -# char Tcl_Backslash(const char *src, int *readPtr) -#} +declare 77 { + char Tcl_Backslash(const char *src, int *readPtr) +} declare 78 { int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList) @@ -1283,7 +1282,7 @@ declare 352 { } declare 353 { int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - size_t numChars) + unsigned long numChars) } declare 354 { char *Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, @@ -1345,10 +1344,10 @@ declare 368 { int Tcl_Stat(const char *path, struct stat *bufPtr) } declare 369 { - int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n) + int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n) } declare 370 { - int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n) + int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n) } declare 371 { int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase) @@ -1519,7 +1518,7 @@ declare 418 { } declare 419 { int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - size_t numChars) + unsigned long numChars) } declare 420 { int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index d3b77b0..ad1dd5f 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -335,7 +335,7 @@ Tcl_RegexpObjCmd( */ if (!doinline) { - Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); } return TCL_OK; } @@ -457,7 +457,7 @@ Tcl_RegexpObjCmd( if (doinline) { Tcl_SetObjResult(interp, resultPtr); } else { - Tcl_SetObjResult(interp, Tcl_NewLongObj(all ? all-1 : 1)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(all ? all-1 : 1)); } return TCL_OK; } @@ -598,7 +598,7 @@ Tcl_RegsubObjCmd( */ int slen, nocase; - int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); + int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long); Tcl_UniChar *p, wsrclc; numMatches = 0; @@ -633,7 +633,7 @@ Tcl_RegsubObjCmd( if ((*wstring == *wsrc || (nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) && (slen==1 || (strCmpFn(wstring, wsrc, - (size_t)slen) == 0))) { + (unsigned long) slen) == 0))) { if (numMatches == 0) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); @@ -959,7 +959,7 @@ Tcl_RegsubObjCmd( * holding the number of matches. */ - Tcl_SetObjResult(interp, Tcl_NewLongObj(numMatches)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(numMatches)); } } else { /* @@ -1118,8 +1118,8 @@ TclNRSourceObjCmd( }; int index; - if (TCL_ERROR == Tcl_GetIndexFromObjStruct(interp, objv[1], options, - sizeof(char *), "option", TCL_EXACT, &index)) { + if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], options, + "option", TCL_EXACT, &index)) { return TCL_ERROR; } encodingName = TclGetString(objv[2]); @@ -1525,8 +1525,8 @@ StringIsCmd( "class ?-strict? ?-failindex var? str"); return TCL_ERROR; } - if (Tcl_GetIndexFromObjStruct(interp, objv[1], isClasses, - sizeof(char *), "class", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[1], isClasses, "class", 0, + &index) != TCL_OK) { return TCL_ERROR; } @@ -1534,8 +1534,8 @@ StringIsCmd( for (i = 2; i < objc-1; i++) { int idx2; - if (Tcl_GetIndexFromObjStruct(interp, objv[i], isOptions, - sizeof(char *), "option", 0, &idx2) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[i], isOptions, "option", 0, + &idx2) != TCL_OK) { return TCL_ERROR; } switch ((enum isOptions) idx2) { @@ -1846,11 +1846,11 @@ StringIsCmd( str_is_done: if ((result == 0) && (failVarObj != NULL) && - Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewLongObj(failat), + Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat), TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewLongObj(result!=0)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; } @@ -1897,7 +1897,7 @@ StringMapCmd( int nocase = 0, mapWithDict = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj, *resultPtr; Tcl_UniChar *ustring1, *ustring2, *p, *end; - int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t); + int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long); if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string"); @@ -2038,7 +2038,7 @@ StringMapCmd( if (((*ustring1 == *ustring2) || (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, - (size_t) length2) == 0)) { + (unsigned long) length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; @@ -2086,7 +2086,7 @@ StringMapCmd( (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* Restrict max compare length. */ (end-ustring1 >= length2) && ((length2 == 1) || - !strCmpFn(ustring2, ustring1, (size_t) length2))) { + !strCmpFn(ustring2, ustring1, (unsigned) length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. @@ -2185,8 +2185,8 @@ StringMatchCmd( return TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewLongObj( - TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)!=0)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + TclStringMatchObj(objv[objc-1], objv[objc-2], nocase))); return TCL_OK; } @@ -2459,7 +2459,7 @@ StringStartCmd( cur += 1; } } - Tcl_SetObjResult(interp, Tcl_NewLongObj(cur)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(cur)); return TCL_OK; } @@ -2521,7 +2521,7 @@ StringEndCmd( } else { cur = numChars; } - Tcl_SetObjResult(interp, Tcl_NewLongObj(cur)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(cur)); return TCL_OK; } @@ -2558,7 +2558,7 @@ StringEqualCmd( const char *string1, *string2; int length1, length2, i, match, length, nocase = 0, reqlength = -1; - typedef int (*strCmpFn_t)(const char *, const char *, size_t); + typedef int (*strCmpFn_t)(const char *, const char *, unsigned int); strCmpFn_t strCmpFn; if (objc < 3 || objc > 6) { @@ -2603,7 +2603,7 @@ StringEqualCmd( * Always match at 0 chars of if it is the same obj. */ - Tcl_SetObjResult(interp, Tcl_NewLongObj(1)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); return TCL_OK; } @@ -2671,7 +2671,7 @@ StringEqualCmd( } } - Tcl_SetObjResult(interp, Tcl_NewLongObj(match==0)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1)); return TCL_OK; } @@ -2708,7 +2708,7 @@ StringCmpCmd( const char *string1, *string2; int length1, length2, i, match, length, nocase = 0, reqlength = -1; - typedef int (*strCmpFn_t)(const char *, const char *, size_t); + typedef int (*strCmpFn_t)(const char *, const char *, unsigned int); strCmpFn_t strCmpFn; if (objc < 3 || objc > 6) { @@ -2753,7 +2753,7 @@ StringCmpCmd( * Always match at 0 chars of if it is the same obj. */ - Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); return TCL_OK; } @@ -2792,11 +2792,11 @@ StringCmpCmd( string1 = (char *) TclGetStringFromObj(objv[0], &length1); string2 = (char *) TclGetStringFromObj(objv[1], &length2); if ((reqlength < 0) && !nocase) { - strCmpFn = TclpUtfNcmp2; + strCmpFn = (strCmpFn_t) TclpUtfNcmp2; } else { length1 = Tcl_NumUtfChars(string1, length1); length2 = Tcl_NumUtfChars(string2, length2); - strCmpFn = nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp; + strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp); } } @@ -2812,13 +2812,13 @@ StringCmpCmd( reqlength = length + 1; } - match = strCmpFn(string1, string2, (size_t) length); + match = strCmpFn(string1, string2, (unsigned) length); if ((match == 0) && (reqlength > length)) { match = length1 - length2; } Tcl_SetObjResult(interp, - Tcl_NewLongObj((match > 0) ? 1 : (match < 0) ? -1 : 0)); + Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0)); return TCL_OK; } @@ -2909,7 +2909,7 @@ StringBytesCmd( } (void) TclGetStringFromObj(objv[1], &length); - Tcl_SetObjResult(interp, Tcl_NewLongObj(length)); + Tcl_SetObjResult(interp, Tcl_NewIntObj(length)); return TCL_OK; } @@ -2943,7 +2943,7 @@ StringLenCmd( return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewLongObj(Tcl_GetCharLength(objv[1]))); + Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_GetCharLength(objv[1]))); return TCL_OK; } @@ -3559,8 +3559,8 @@ TclNRSwitchObjCmd( if (TclGetString(objv[i])[0] != '-') { break; } - if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, - sizeof(char *), "option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, + &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { @@ -3836,7 +3836,7 @@ TclNRSwitchObjCmd( rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start); rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1); } else { - rangeObjAry[0] = rangeObjAry[1] = Tcl_NewLongObj(-1); + rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1); } /* @@ -4156,7 +4156,7 @@ Tcl_TimeObjCmd( * Use int obj since we know time is not fractional. [Bug 1202178] */ - objs[0] = Tcl_NewLongObj((count <= 0) ? 0 : (int) totalMicroSec); + objs[0] = Tcl_NewIntObj((count <= 0) ? 0 : (int) totalMicroSec); } else { objs[0] = Tcl_NewDoubleObj(totalMicroSec/count); } @@ -4236,8 +4236,8 @@ TclNRTryObjCmd( int type; Tcl_Obj *info[5]; - if (Tcl_GetIndexFromObjStruct(interp, objv[i], handlerNames, - sizeof(char *), "handler type", 0, &type) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type", + 0, &type) != TCL_OK) { Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 720a994..ab2823c 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -238,7 +238,8 @@ TCLAPI void Tcl_AsyncMark(Tcl_AsyncHandler async); TCLAPI int Tcl_AsyncReady(void); /* 76 */ TCLAPI void Tcl_BackgroundError(Tcl_Interp *interp); -/* Slot 77 is reserved */ +/* 77 */ +TCLAPI char Tcl_Backslash(const char *src, int *readPtr); /* 78 */ TCLAPI int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, @@ -955,7 +956,8 @@ TCLAPI int Tcl_UniCharIsWordChar(int ch); TCLAPI int Tcl_UniCharLen(const Tcl_UniChar *uniStr); /* 353 */ TCLAPI int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); + const Tcl_UniChar *uct, + unsigned long numChars); /* 354 */ TCLAPI char * Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); @@ -1002,10 +1004,11 @@ TCLAPI int Tcl_Access(const char *path, int mode); /* 368 */ TCLAPI int Tcl_Stat(const char *path, struct stat *bufPtr); /* 369 */ -TCLAPI int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n); +TCLAPI int Tcl_UtfNcmp(const char *s1, const char *s2, + unsigned long n); /* 370 */ TCLAPI int Tcl_UtfNcasecmp(const char *s1, const char *s2, - size_t n); + unsigned long n); /* 371 */ TCLAPI int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase); @@ -1134,7 +1137,8 @@ TCLAPI void Tcl_ClearChannelHandlers(Tcl_Channel channel); TCLAPI int Tcl_IsChannelExisting(const char *channelName); /* 419 */ TCLAPI int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); + const Tcl_UniChar *uct, + unsigned long numChars); /* 420 */ TCLAPI int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); @@ -1840,7 +1844,7 @@ typedef struct TclStubs { void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */ int (*tcl_AsyncReady) (void); /* 75 */ void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */ - void (*reserved77)(void); + char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */ int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */ void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */ void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */ @@ -2124,7 +2128,7 @@ typedef struct TclStubs { int (*tcl_UniCharIsUpper) (int ch); /* 350 */ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */ int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ - int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 353 */ + int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */ char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */ Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ @@ -2140,8 +2144,8 @@ typedef struct TclStubs { int (*tcl_Chdir) (const char *dirName); /* 366 */ int (*tcl_Access) (const char *path, int mode); /* 367 */ int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */ - int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */ - int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */ + int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n); /* 369 */ + int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n); /* 370 */ int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */ int (*tcl_UniCharIsControl) (int ch); /* 372 */ int (*tcl_UniCharIsGraph) (int ch); /* 373 */ @@ -2190,7 +2194,7 @@ typedef struct TclStubs { void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */ void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */ int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ - int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 419 */ + int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */ int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ void (*reserved421)(void); void (*reserved422)(void); @@ -2577,7 +2581,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_AsyncReady) /* 75 */ #define Tcl_BackgroundError \ (tclStubsPtr->tcl_BackgroundError) /* 76 */ -/* Slot 77 is reserved */ +#define Tcl_Backslash \ + (tclStubsPtr->tcl_Backslash) /* 77 */ #define Tcl_BadChannelOption \ (tclStubsPtr->tcl_BadChannelOption) /* 78 */ #define Tcl_CallWhenDeleted \ diff --git a/generic/tclInt.decls b/generic/tclInt.decls index b21822e..60cd635 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -702,7 +702,7 @@ declare 166 { #} # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 { - int TclpUtfNcmp2(const char *s1, const char *s2, size_t n) + int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n) } declare 170 { int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 381c22e..45b87b9 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -365,7 +365,7 @@ TCLAPI int TclListObjSetElement(Tcl_Interp *interp, /* Slot 168 is reserved */ /* 169 */ TCLAPI int TclpUtfNcmp2(const char *s1, const char *s2, - size_t n); + unsigned long n); /* 170 */ TCLAPI int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, int numChars, @@ -745,7 +745,7 @@ typedef struct TclIntStubs { int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */ void (*reserved167)(void); void (*reserved168)(void); - int (*tclpUtfNcmp2) (const char *s1, const char *s2, size_t n); /* 169 */ + int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */ int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ int (*tclInThreadExit) (void); /* 172 */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 88118a3..1a704da 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -796,7 +796,7 @@ const TclStubs tclStubs = { Tcl_AsyncMark, /* 74 */ Tcl_AsyncReady, /* 75 */ Tcl_BackgroundError, /* 76 */ - 0, /* 77 */ + Tcl_Backslash, /* 77 */ Tcl_BadChannelOption, /* 78 */ Tcl_CallWhenDeleted, /* 79 */ Tcl_CancelIdleCall, /* 80 */ diff --git a/generic/tclUtf.c b/generic/tclUtf.c index b7813fc..25cc2d1 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -986,7 +986,7 @@ int TclpUtfNcmp2( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numBytes) /* Number of *bytes* to compare. */ + unsigned long numBytes) /* Number of *bytes* to compare. */ { /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to @@ -1033,7 +1033,7 @@ int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF chars to compare. */ + unsigned long numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; @@ -1081,7 +1081,7 @@ int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - size_t numChars) /* Number of UTF chars to compare. */ + unsigned long numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; while (numChars-- > 0) { @@ -1285,7 +1285,7 @@ int Tcl_UniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of unichars to compare. */ + unsigned long numChars) /* Number of unichars to compare. */ { #ifdef WORDS_BIGENDIAN /* @@ -1330,7 +1330,7 @@ int Tcl_UniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of unichars to compare. */ + unsigned long numChars) /* Number of unichars to compare. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index cc5c0f0..e2bcd37 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -937,9 +937,9 @@ Tcl_SplitList( int Tcl_ScanElement( - const char *src, /* String to convert to list element. */ - int *flagPtr) /* Where to store information to guide - * Tcl_ConvertCountedElement. */ + register const char *src, /* String to convert to list element. */ + register int *flagPtr) /* Where to store information to guide + * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); } @@ -1300,9 +1300,9 @@ TclScanElement( int Tcl_ConvertElement( - const char *src, /* Source information for list element. */ - char *dst, /* Place to put list-ified element. */ - int flags) /* Flags produced by Tcl_ScanElement. */ + register const char *src, /* Source information for list element. */ + register char *dst, /* Place to put list-ified element. */ + register int flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, -1, dst, flags); } @@ -1551,6 +1551,7 @@ Tcl_Merge( char localFlags[LOCAL_SIZE]; int i, bytesNeeded = 0; char *result, *dst, *flagPtr = NULL; + const int maxFlags = UINT_MAX / sizeof(int); /* * Handle empty list case first, so logic of the general case can be @@ -1569,6 +1570,20 @@ Tcl_Merge( if (argc <= LOCAL_SIZE) { flagPtr = localFlags; + } else if (argc > maxFlags) { + /* + * We cannot allocate a large enough flag array to format this list in + * one pass. We could imagine converting this routine to a multi-pass + * implementation, but for sizeof(int) == 4, the limit is a max of + * 2^30 list elements and since each element is at least one byte + * formatted, and requires one byte space between it and the next one, + * that a minimum space requirement of 2^31 bytes, which is already + * INT_MAX. If we tried to format a list of > maxFlags elements, we're + * just going to overflow the size limits on the formatted string + * anyway, so just issue that same panic early. + */ + + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } else { flagPtr = ckalloc(argc); } @@ -1607,6 +1622,40 @@ Tcl_Merge( /* *---------------------------------------------------------------------- * + * Tcl_Backslash -- + * + * Figure out how to handle a backslash sequence. + * + * Results: + * The return value is the character that should be substituted in place + * of the backslash sequence that starts at src. If readPtr isn't NULL + * then it is filled in with a count of the number of characters in the + * backslash sequence. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +char +Tcl_Backslash( + const char *src, /* Points to the backslash character of a + * backslash sequence. */ + int *readPtr) /* Fill in with number of characters read from + * src, unless NULL. */ +{ + char buf[TCL_UTF_MAX]; + Tcl_UniChar ch = 0; + + Tcl_UtfBackslash(src, readPtr, buf); + TclUtfToUniChar(buf, &ch); + return (char) ch; +} + +/* + *---------------------------------------------------------------------- + * * TclTrimRight -- * * Takes two counted strings in the Tcl encoding which must both be null @@ -3226,7 +3275,7 @@ TclPrecTraceProc( if (flags & TCL_TRACE_READS) { - Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewLongObj(*precisionPtr), + Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr), flags & TCL_GLOBAL_ONLY); return NULL; } -- cgit v0.12