diff options
48 files changed, 1028 insertions, 452 deletions
diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3 index 7290a27..1b3a848 100644 --- a/doc/AddErrInfo.3 +++ b/doc/AddErrInfo.3 @@ -67,9 +67,6 @@ The \fB\-errorcode\fR return option will be set to this value. .AP "const char" *element in String to record as one element of the \fB\-errorcode\fR return option. Last \fIelement\fR argument must be NULL. -.AP va_list argList in -An argument list which must have been initialized using -\fBva_start\fR, and cleared using \fBva_end\fR. .AP int lineNum The line number of a script where an error occurred. .AP "const char" *script in diff --git a/doc/Panic.3 b/doc/Panic.3 index e8a5cb8..2f5d19c 100644 --- a/doc/Panic.3 +++ b/doc/Panic.3 @@ -27,10 +27,6 @@ void A printf-style format string. .AP "" arg in Arguments matching the format string. -.AP va_list argList in -An argument list of arguments matching the format string. -Must have been initialized using \fBva_start\fR, -and cleared using \fBva_end\fR. .AP Tcl_PanicProc *panicProc in Procedure to report fatal error message and abort. .BE diff --git a/doc/SetResult.3 b/doc/SetResult.3 index 9be3ef0..fdc4af2 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -45,9 +45,6 @@ to the existing result of \fIinterp\fR. .AP Tcl_FreeProc *freeProc in Pointer to a procedure to call to release storage at \fIresult\fR. -.AP va_list argList in -An argument list which must have been initialized using -\fBva_start\fR, and cleared using \fBva_end\fR. .AP Tcl_Interp *sourceInterp in The interpreter to transfer the result and return options from. .AP Tcl_Interp *targetInterp in diff --git a/doc/StringObj.3 b/doc/StringObj.3 index d835140..f8c3a58 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -115,7 +115,7 @@ The index of the last Unicode character in the Unicode range to be returned as a new value. If negative, take all characters up to the last one available. .AP Tcl_Obj *objPtr in/out -Points to a value to manipulate. +A pointer to a value to read, or to an unshared value to modify. .AP Tcl_Obj *appendObjPtr in The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR. .AP "Tcl_Size \&| int" *lengthPtr out @@ -123,9 +123,6 @@ The location where \fBTcl_GetStringFromObj\fR will store the length of a value's string representation. May be (int *)NULL when not used. .AP "const char" *string in Null-terminated string value to append to \fIobjPtr\fR. -.AP va_list argList in -An argument list which must have been initialized using -\fBva_start\fR, and cleared using \fBva_end\fR. .AP Tcl_Size limit in Maximum number of bytes to be appended. .AP "const char" *ellipsis in diff --git a/doc/encoding.n b/doc/encoding.n index b216ebe..255e070 100644 --- a/doc/encoding.n +++ b/doc/encoding.n @@ -1,5 +1,6 @@ '\" '\" Copyright (c) 1998 Scriptics Corporation. +'\" Copyright (c) 2023 Nathan Coulter '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. diff --git a/generic/tcl.decls b/generic/tcl.decls index 1ba2ce8..30e4dea 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -146,7 +146,7 @@ declare 32 { } # Only available in Tcl 8.x, NULL in Tcl 9.0 declare 33 { - unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr) + unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, void *numBytesPtr) } declare 34 { int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr) @@ -173,7 +173,7 @@ declare 40 { const Tcl_ObjType *Tcl_GetObjType(const char *typeName) } declare 41 { - char *TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) + char *TclGetStringFromObj(Tcl_Obj *objPtr, void *lengthPtr) } declare 42 { void Tcl_InvalidateStringRep(Tcl_Obj *objPtr) @@ -188,7 +188,7 @@ declare 44 { } declare 45 { int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, - int *objcPtr, Tcl_Obj ***objvPtr) + void *objcPtr, Tcl_Obj ***objvPtr) } declare 46 { int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, @@ -196,7 +196,7 @@ declare 46 { } declare 47 { int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, - int *lengthPtr) + void *lengthPtr) } declare 48 { int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, @@ -881,12 +881,12 @@ declare 241 { void Tcl_SourceRCFile(Tcl_Interp *interp) } declare 242 { - int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, + int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr, const char ***argvPtr) } # Obsolete, use Tcl_FSSplitPath declare 243 { - void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr) + void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) } # Removed in 9.0 (stub entry only) #declare 244 { @@ -1601,7 +1601,7 @@ declare 433 { # introduced in 8.4a3 declare 434 { - Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr) + Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, void *lengthPtr) } # TIP#15 (math function introspection) dkf @@ -1702,7 +1702,7 @@ declare 460 { Tcl_Obj *Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements) } declare 461 { - Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) + Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) } declare 462 { int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr) @@ -1841,7 +1841,7 @@ declare 496 { Tcl_Obj *keyPtr) } declare 497 { - int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr) + int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, void *sizePtr) } declare 498 { int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr, @@ -2270,7 +2270,7 @@ declare 603 { # TIP#265 (option parser) dkf for Sam Bromley declare 604 { int TclParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, - int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) + void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) } # TIP#336 (manipulate the error line) dgp @@ -2468,7 +2468,7 @@ declare 648 { # TIP #568 declare 649 { unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - int *numBytesPtr) + void *numBytesPtr) } declare 650 { unsigned char *Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, diff --git a/generic/tcl.h b/generic/tcl.h index 69ab2c4..076f27e 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1967,7 +1967,11 @@ typedef struct Tcl_EncodingType { #define TCL_ENCODING_CHAR_LIMIT 0x10 /* Internal use bits, do not define bits in this space. See above comment */ #define TCL_ENCODING_INTERNAL_USE_MASK 0xFF00 -/* Reserve top byte for profile values (disjoint, not a mask) */ +/* + * Reserve top byte for profile values (disjoint, not a mask). In case of + * changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if + * necessary. + */ #define TCL_ENCODING_PROFILE_STRICT TCL_ENCODING_STOPONERROR #define TCL_ENCODING_PROFILE_TCL8 0x01000000 #define TCL_ENCODING_PROFILE_REPLACE 0x02000000 diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 9d87f1a..4571b4a 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -13,36 +13,95 @@ #include "tclInt.h" #include "tclArithSeries.h" #include <assert.h> +#include <math.h> /* -------------------------- ArithSeries object ---------------------------- */ +/* + * Helper functions + * + * - ArithRound -- Round doubles to the number of significant fractional + * digits + * - ArithSeriesIndexDbl -- base list indexing operation for doubles + * - ArithSeriesIndexInt -- " " " " " integers + * - ArithSeriesGetInternalRep -- Return the internal rep from a Tcl_Obj + * - Precision -- determine the number of factional digits for the given + * double value + * - maxPrecision -- Using the values provide, determine the longest percision + * in the arithSeries + */ +static inline double +ArithRound(double d, unsigned int n) { + double scalefactor = pow(10, n); + return round(d*scalefactor)/scalefactor; +} -#define ArithSeriesRepPtr(arithSeriesObjPtr) \ - (ArithSeries *) ((arithSeriesObjPtr)->internalRep.twoPtrValue.ptr1) +static inline double +ArithSeriesIndexDbl( + ArithSeries *arithSeriesRepPtr, + Tcl_WideInt index) +{ + ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr; + if (arithSeriesRepPtr->isDouble) { + double d = dblRepPtr->start + (index * dblRepPtr->step); + unsigned n = (dblRepPtr->precision > 0 ? dblRepPtr->precision : 0); + return ArithRound(d, n); + } else { + return (double)(arithSeriesRepPtr->start + (index * arithSeriesRepPtr->step)); + } +} -#define ArithSeriesIndexM(arithSeriesRepPtr, index) \ - ((arithSeriesRepPtr)->isDouble ? \ - (((ArithSeriesDbl*)(arithSeriesRepPtr))->start+((index) * ((ArithSeriesDbl*)(arithSeriesRepPtr))->step)) \ - : \ - ((arithSeriesRepPtr)->start+((index) * arithSeriesRepPtr->step))) +static inline Tcl_WideInt +ArithSeriesIndexInt( + ArithSeries *arithSeriesRepPtr, + Tcl_WideInt index) +{ + ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr; + if (arithSeriesRepPtr->isDouble) { + return (Tcl_WideInt)(dblRepPtr->start + ((index) * dblRepPtr->step)); + } else { + return (arithSeriesRepPtr->start + (index * arithSeriesRepPtr->step)); + } +} -#define ArithSeriesGetInternalRep(objPtr, arithRepPtr) \ - do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType.objType); \ - (arithRepPtr) = irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL; \ - } while (0) +static inline ArithSeries* +ArithSeriesGetInternalRep(Tcl_Obj *objPtr) +{ + const Tcl_ObjInternalRep *irPtr; + irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType.objType); + return irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL; +} +static inline int +Precision(double d) +{ + char tmp[TCL_DOUBLE_SPACE+2], *off; + tmp[0] = 0; + Tcl_PrintDouble(NULL,d,tmp); + off = strchr(tmp, '.'); + return (off ? strlen(off+1) : 0); +} +static inline int +maxPrecision(double start, double end, double step) +{ + // Find longest number of digits after the decimal point. + int dp = Precision(step); + int i = Precision(start); + dp = i>dp ? i : dp; + i = Precision(end); + dp = i>dp ? i : dp; + return dp; +} /* * Prototypes for procedures defined later in this file: */ -static void DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -static void FreeArithSeriesInternalRep (Tcl_Obj *listPtr); -static int SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr); -static void UpdateStringOfArithSeries (Tcl_Obj *arithSeriesObj); -static Tcl_Obj *ArithSeriesObjStep(Tcl_Obj *arithSeriesPtr); +static void DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void FreeArithSeriesInternalRep (Tcl_Obj *listPtr); +static int SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr); +static void UpdateStringOfArithSeries (Tcl_Obj *arithSeriesObj); +static Tcl_Obj* ArithSeriesObjStep(Tcl_Obj *arithSeriesPtr); static Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesPtr); /* @@ -107,7 +166,7 @@ const TclObjTypeWithAbstractList tclArithSeriesType = { *---------------------------------------------------------------------- */ static Tcl_WideInt -ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step) +ArithSeriesLenInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step) { Tcl_WideInt len; @@ -118,6 +177,18 @@ ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step) return (len < 0) ? -1 : len; } +static Tcl_WideInt +ArithSeriesLenDbl(double start, double end, double step) +{ + Tcl_WideInt len; + + if (step == 0) { + return 0; + } + len = ((end-start+step)/step); + return (len < 0) ? -1 : len; +} + /* *---------------------------------------------------------------------- * @@ -140,10 +211,13 @@ static Tcl_Obj * NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len) { - Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step)); + Tcl_WideInt length; Tcl_Obj *arithSeriesObj; ArithSeries *arithSeriesRepPtr; + length = len>=0 ? len : -1; + if (length < 0) length = -1; + TclNewObj(arithSeriesObj); if (length <= 0) { @@ -184,14 +258,20 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide * None. *---------------------------------------------------------------------- */ + static Tcl_Obj * NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len) { - Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step)); + Tcl_WideInt length; Tcl_Obj *arithSeriesObj; ArithSeriesDbl *arithSeriesRepPtr; + length = len>=0 ? len : -1; + if (length < 0) { + length = -1; + } + TclNewObj(arithSeriesObj); if (length <= 0) { @@ -205,11 +285,14 @@ NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len) arithSeriesRepPtr->step = step; arithSeriesRepPtr->len = length; arithSeriesRepPtr->elements = NULL; + arithSeriesRepPtr->precision = maxPrecision(start,end,step); arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr; arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL; arithSeriesObj->typePtr = &tclArithSeriesType.objType; - if (length > 0) + + if (length > 0) { Tcl_InvalidateStringRep(arithSeriesObj); + } return arithSeriesObj; } @@ -295,7 +378,7 @@ TclNewArithSeriesObj( { double dstart, dend, dstep; Tcl_WideInt start, end, step; - Tcl_WideInt len; + Tcl_WideInt len = -1; if (startObj) { assignNumber(useDoubles, &start, &dstart, startObj); @@ -337,9 +420,9 @@ TclNewArithSeriesObj( assert(dstep!=0); if (!lenObj) { if (useDoubles) { - len = (dend - dstart + dstep)/dstep; + len = ArithSeriesLenDbl(dstart, dend, dstep); } else { - len = (end - start + step)/step; + len = ArithSeriesLenInt(start, end, step); } } } @@ -354,7 +437,7 @@ TclNewArithSeriesObj( } } - if (TCL_MAJOR_VERSION < 9 && len > ListSizeT_MAX) { + if (len > TCL_SIZE_MAX) { Tcl_SetObjResult( interp, Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); @@ -398,7 +481,7 @@ ArithSeriesObjStep( if (arithSeriesObj->typePtr != &tclArithSeriesType.objType) { Tcl_Panic("ArithSeriesObjStep called with a not ArithSeries Obj."); } - arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObj); + arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); if (arithSeriesRepPtr->isDouble) { TclNewDoubleObj(stepObj, ((ArithSeriesDbl*)(arithSeriesRepPtr))->step); } else { @@ -430,7 +513,7 @@ ArithSeriesObjStep( Tcl_Obj * TclArithSeriesObjIndex( - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), Tcl_Obj *arithSeriesObj, Tcl_WideInt index) { @@ -439,21 +522,15 @@ TclArithSeriesObjIndex( if (arithSeriesObj->typePtr != &tclArithSeriesType.objType) { Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj."); } - arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObj); + arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); if (index < 0 || (Tcl_Size)index >= arithSeriesRepPtr->len) { - if (interp) { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("index %" TCL_LL_MODIFIER "d is out of bounds 0 to %" - TCL_LL_MODIFIER "d", index, (arithSeriesRepPtr->len-1))); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - } - return NULL; + return Tcl_NewObj(); } /* List[i] = Start + (Step * index) */ if (arithSeriesRepPtr->isDouble) { - return Tcl_NewDoubleObj(ArithSeriesIndexM(arithSeriesRepPtr, index)); + return Tcl_NewDoubleObj(ArithSeriesIndexDbl(arithSeriesRepPtr, index)); } else { - return Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index)); + return Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index)); } } @@ -541,16 +618,25 @@ DupArithSeriesInternalRep( Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ArithSeries *srcArithSeriesRepPtr = - (ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1; - ArithSeries *copyArithSeriesRepPtr; - + (ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1; /* * Allocate a new ArithSeries structure. */ - copyArithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof(ArithSeries)); - *copyArithSeriesRepPtr = *srcArithSeriesRepPtr; - copyArithSeriesRepPtr->elements = NULL; - copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr; + if (srcArithSeriesRepPtr->isDouble) { + ArithSeriesDbl *srcArithSeriesDblRepPtr = + (ArithSeriesDbl *)srcArithSeriesRepPtr; + ArithSeriesDbl *copyArithSeriesDblRepPtr = + (ArithSeriesDbl *) Tcl_Alloc(sizeof(ArithSeriesDbl)); + *copyArithSeriesDblRepPtr = *srcArithSeriesDblRepPtr; + copyArithSeriesDblRepPtr->elements = NULL; + copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesDblRepPtr; + } else { + ArithSeries *copyArithSeriesRepPtr = + (ArithSeries *) Tcl_Alloc(sizeof(ArithSeries)); + *copyArithSeriesRepPtr = *srcArithSeriesRepPtr; + copyArithSeriesRepPtr->elements = NULL; + copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr; + } copyPtr->internalRep.twoPtrValue.ptr2 = NULL; copyPtr->typePtr = &tclArithSeriesType.objType; } @@ -591,29 +677,47 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObj) char *elem, *p; Tcl_Obj *elemObj; Tcl_Size i; - Tcl_WideInt length = 0; + Tcl_Size length = 0; Tcl_Size slen; /* * Pass 1: estimate space. */ - for (i = 0; i < arithSeriesRepPtr->len; i++) { - elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, i); - elem = Tcl_GetStringFromObj(elemObj, &slen); - Tcl_DecrRefCount(elemObj); - slen += 1; /* + 1 is for the space or the nul-term */ - length += slen; + if (!arithSeriesRepPtr->isDouble) { + for (i = 0; i < arithSeriesRepPtr->len; i++) { + double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i); + slen = d>0 ? log10(d)+1 : d<0 ? log10((0-d))+2 : 1; + length += slen; + } + } else { + for (i = 0; i < arithSeriesRepPtr->len; i++) { + double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i); + char tmp[TCL_DOUBLE_SPACE+2]; + tmp[0] = 0; + Tcl_PrintDouble(NULL,d,tmp); + if ((length + strlen(tmp)) > TCL_SIZE_MAX) { + break; // overflow + } + length += strlen(tmp); + } } + length += arithSeriesRepPtr->len; // Space for each separator /* * Pass 2: generate the string repr. */ p = Tcl_InitStringRep(arithSeriesObj, NULL, length); + if (p == NULL) { + Tcl_Panic("Unable to allocate string size %" TCL_Z_MODIFIER "u", length); + } for (i = 0; i < arithSeriesRepPtr->len; i++) { elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, i); elem = Tcl_GetStringFromObj(elemObj, &slen); - strcpy(p, elem); + if (((p - arithSeriesObj->bytes)+slen) > length) { + break; + } + strncpy(p, elem, slen); p[slen] = ' '; p += slen+1; Tcl_DecrRefCount(elemObj); @@ -685,7 +789,7 @@ TclArithSeriesObjCopy( Tcl_Obj *copyPtr; ArithSeries *arithSeriesRepPtr; - ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr); + arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); if (NULL == arithSeriesRepPtr) { if (SetArithSeriesFromAny(interp, arithSeriesObj) != TCL_OK) { /* We know this is going to panic, but it's the message we want */ @@ -728,17 +832,30 @@ TclArithSeriesObjRange( ArithSeries *arithSeriesRepPtr; Tcl_Obj *startObj, *endObj, *stepObj; - ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr); + arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); if (fromIdx == TCL_INDEX_NONE) { fromIdx = 0; } - if (fromIdx > toIdx) { + + if (fromIdx > toIdx || + (toIdx > arithSeriesRepPtr->len-1 && + fromIdx > arithSeriesRepPtr->len-1)) { Tcl_Obj *obj; TclNewObj(obj); return obj; } + if (fromIdx < 0) { + fromIdx = 0; + } + if (toIdx < 0) { + toIdx = 0; + } + if (toIdx > arithSeriesRepPtr->len-1) { + toIdx = arithSeriesRepPtr->len-1; + } + startObj = TclArithSeriesObjIndex(interp, arithSeriesObj, fromIdx); if (startObj == NULL) { return NULL; @@ -778,15 +895,17 @@ TclArithSeriesObjRange( TclInvalidateStringRep(arithSeriesObj); if (arithSeriesRepPtr->isDouble) { - ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesObj; + ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr; double start, end, step; + Tcl_GetDoubleFromObj(NULL, startObj, &start); Tcl_GetDoubleFromObj(NULL, endObj, &end); Tcl_GetDoubleFromObj(NULL, stepObj, &step); arithSeriesDblRepPtr->start = start; arithSeriesDblRepPtr->end = end; arithSeriesDblRepPtr->step = step; - arithSeriesDblRepPtr->len = (end-start+step)/step; + arithSeriesDblRepPtr->precision = maxPrecision(start, end, step); + arithSeriesDblRepPtr->len = ArithSeriesLenDbl(start, end, step); arithSeriesDblRepPtr->elements = NULL; } else { @@ -797,7 +916,7 @@ TclArithSeriesObjRange( arithSeriesRepPtr->start = start; arithSeriesRepPtr->end = end; arithSeriesRepPtr->step = step; - arithSeriesRepPtr->len = (end-start+step)/step; + arithSeriesRepPtr->len = ArithSeriesLenInt(start, end, step); arithSeriesRepPtr->elements = NULL; } @@ -852,7 +971,7 @@ TclArithSeriesGetElements( Tcl_Obj **objv; int i, objc; - ArithSeriesGetInternalRep(objPtr, arithSeriesRepPtr); + arithSeriesRepPtr = ArithSeriesGetInternalRep(objPtr); objc = arithSeriesRepPtr->len; if (objc > 0) { if (arithSeriesRepPtr->elements) { @@ -927,7 +1046,7 @@ TclArithSeriesObjReverse( double dstart, dend, dstep; int isDouble; - ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr); + arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); isDouble = arithSeriesRepPtr->isDouble; len = arithSeriesRepPtr->len; diff --git a/generic/tclArithSeries.h b/generic/tclArithSeries.h index bb8dfa8..61538c4 100644 --- a/generic/tclArithSeries.h +++ b/generic/tclArithSeries.h @@ -30,6 +30,7 @@ typedef struct { double start; double end; double step; + int precision; } ArithSeriesDbl; diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 480b72e..8510c32 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -3298,7 +3298,7 @@ invokeObj2Command( Command *cmdPtr = (Command *) clientData; if (objc > INT_MAX) { - objc = TCL_INDEX_NONE; /* TODO - why? Should error, not truncate */ + return TclCommandWordLimitError(interp, objc); } if (cmdPtr->objProc != NULL) { result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); @@ -3315,6 +3315,9 @@ static int cmdWrapper2Proc(void *clientData, Tcl_Obj *const objv[]) { Command *cmdPtr = (Command *)clientData; + if (objc > INT_MAX) { + return TclCommandWordLimitError(interp, objc); + } return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); } @@ -5164,17 +5167,17 @@ TclEvalEx( { Interp *iPtr = (Interp *) interp; const char *p, *next; - const unsigned int minObjs = 20; + const int minObjs = 20; Tcl_Obj **objv, **objvSpace; int *expand, *lines, *lineSpace; Tcl_Token *tokenPtr; - int bytesLeft, expandRequested, code = TCL_OK; - Tcl_Size commandLength; + int expandRequested, code = TCL_OK; + Tcl_Size bytesLeft, commandLength; CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); int gotParse = 0; - TCL_HASH_TYPE i, objectsUsed = 0; + Tcl_Size i, objectsUsed = 0; /* These variables keep track of how much * state has been allocated while evaluating * the script, so that it can be freed @@ -5312,8 +5315,8 @@ TclEvalEx( Tcl_Size wordLine = line; const char *wordStart = parsePtr->commandStart; int *wordCLNext = clNext; - unsigned int objectsNeeded = 0; - unsigned int numWords = parsePtr->numWords; + Tcl_Size objectsNeeded = 0; + Tcl_Size numWords = parsePtr->numWords; /* * Generate an array of objects for the words of the command. @@ -5332,6 +5335,8 @@ TclEvalEx( for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr; objectsUsed < numWords; objectsUsed++, tokenPtr += tokenPtr->numComponents+1) { + Tcl_Size additionalObjsCount; + /* * TIP #280. Track lines to current word. Save the information * on a per-word basis, signaling dynamic words as needed. @@ -5381,11 +5386,21 @@ TclEvalEx( expandRequested = 1; expand[objectsUsed] = 1; - objectsNeeded += (numElements ? numElements : 1); + additionalObjsCount = (numElements ? numElements : 1); + } else { expand[objectsUsed] = 0; - objectsNeeded++; + additionalObjsCount = 1; + } + + /* Currently max command words in INT_MAX */ + if (additionalObjsCount > INT_MAX || + objectsNeeded > (INT_MAX - additionalObjsCount)) { + code = TclCommandWordLimitError(interp, -1); + Tcl_DecrRefCount(objv[objectsUsed]); + break; } + objectsNeeded += additionalObjsCount; if (wordCLNext) { TclContinuationsEnterDerived(objv[objectsUsed], diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 3a9d62e..dd8b292 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -386,7 +386,7 @@ unsigned char * TclGetBytesFromObj( Tcl_Interp *interp, /* For error reporting */ Tcl_Obj *objPtr, /* Value to extract from */ - int *numBytesPtr) /* If non-NULL, write the number of bytes + void *numBytesPtr) /* If non-NULL, write the number of bytes * in the array here */ { Tcl_Size numBytes = 0; @@ -404,7 +404,7 @@ TclGetBytesFromObj( } return NULL; } else { - *numBytesPtr = (int) numBytes; + *(int *)numBytesPtr = (int) numBytes; } } return bytes; @@ -870,7 +870,7 @@ BinaryFormatCmd( int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ - Tcl_Size count; /* Count associated with current format + Tcl_Size count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format @@ -1383,7 +1383,7 @@ BinaryScanCmd( int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ - Tcl_Size count; /* Count associated with current format + Tcl_Size count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format @@ -1795,14 +1795,14 @@ GetFormatSpec( (*formatPtr)++; *countPtr = BINARY_ALL; } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */ - unsigned long count; + unsigned long long count; errno = 0; - count = strtoul(*formatPtr, (char **) formatPtr, 10); - if (errno || (count > (unsigned long) INT_MAX)) { - *countPtr = INT_MAX; + count = strtoull(*formatPtr, (char **) formatPtr, 10); + if (errno || (count > TCL_SIZE_MAX)) { + *countPtr = TCL_SIZE_MAX; } else { - *countPtr = (int) count; + *countPtr = count; } } else { *countPtr = BINARY_NOCOUNT; @@ -2638,11 +2638,11 @@ BinaryEncode64( { Tcl_Obj *resultObj; unsigned char *data, *limit; - int maxlen = 0; + Tcl_Size maxlen = 0; const char *wrapchar = "\n"; Tcl_Size wrapcharlen = 1; - int i, index, size, outindex = 0, purewrap = 1; - Tcl_Size offset, count = 0; + int index, purewrap = 1; + Tcl_Size i, offset, size, outindex = 0, count = 0; enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; @@ -2658,7 +2658,7 @@ BinaryEncode64( } switch (index) { case OPT_MAXLEN: - if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { + if (Tcl_GetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { return TCL_ERROR; } if (maxlen < 0) { @@ -2764,12 +2764,12 @@ BinaryEncodeUu( { Tcl_Obj *resultObj; unsigned char *data, *start, *cursor; - int rawLength, i, bits, index; + int i, bits, index; unsigned int n; int lineLength = 61; const unsigned char SingleNewline[] = { UCHAR('\n') }; const unsigned char *wrapchar = SingleNewline; - Tcl_Size j, offset, count = 0, wrapcharlen = sizeof(SingleNewline); + Tcl_Size j, rawLength, offset, count = 0, wrapcharlen = sizeof(SingleNewline); enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; @@ -2859,7 +2859,7 @@ BinaryEncodeUu( */ while (offset < count) { - int lineLen = count - offset; + Tcl_Size lineLen = count - offset; if (lineLen > rawLength) { lineLen = rawLength; diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index da9814b..a4e999c 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2642,8 +2642,8 @@ StringEqualCmd( */ const char *string2; - int i, match, nocase = 0, reqlength = -1; - Tcl_Size length; + int i, match, nocase = 0; + Tcl_Size length, reqlength = -1; if (objc < 3 || objc > 6) { str_cmp_args: @@ -2662,7 +2662,7 @@ StringEqualCmd( goto str_cmp_args; } i++; - if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) { + if (TclGetSizeIntFromObj(interp, objv[i], &reqlength) != TCL_OK) { return TCL_ERROR; } } else { @@ -2717,7 +2717,8 @@ StringCmpCmd( * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...). */ - int match, nocase, reqlength, status; + int match, nocase, status; + Tcl_Size reqlength; status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength); if (status != TCL_OK) { @@ -2736,7 +2737,7 @@ TclStringCmpOpts( int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ int *nocase, - int *reqlength) + Tcl_Size *reqlength) { int i; Tcl_Size length; @@ -2761,7 +2762,7 @@ TclStringCmpOpts( goto str_cmp_args; } i++; - if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) { + if (TclGetSizeIntFromObj(interp, objv[i], reqlength) != TCL_OK) { return TCL_ERROR; } } else { diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 531fbf0..05d50e9 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -2669,7 +2669,7 @@ TclCompileTailcallCmd( Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; - if (parsePtr->numWords < 2 || parsePtr->numWords > 256 + if (parsePtr->numWords < 2 || parsePtr->numWords >= 256 || envPtr->procPtr == NULL) { return TCL_ERROR; } diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 5da5cf1..926c492 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -870,6 +870,18 @@ TclSetByteCodeFromAny( } /* + * After optimization is all done, check that byte code length limits + * are not exceeded. Bug [27b3ce2997]. + */ + if ((compEnv.codeNext - compEnv.codeStart) > INT_MAX) { + /* + * Cannot just return TCL_ERROR as callers ignore return value. + * TODO - May be use TclCompileSyntaxError here? + */ + Tcl_Panic("Maximum byte code length %d exceeded.", INT_MAX); + } + + /* * Change the object into a ByteCode object. Ownership of the literal * objects and aux data items passes to the ByteCode object. */ @@ -2136,7 +2148,7 @@ TclCompileScript( * serves as context for finding and compiling * commands. May not be NULL. */ const char *script, /* The source script to compile. */ - size_t numBytes, /* Number of bytes in script. If -1, the + Tcl_Size numBytes, /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ CompileEnv *envPtr) /* Holds resulting instructions. */ @@ -2167,9 +2179,26 @@ TclCompileScript( return; } + if (numBytes < 0) { + numBytes = strlen(script); + } + /* Each iteration compiles one command from the script. */ - if (numBytes + 1 > 1) { + if (numBytes > 0) { + if (numBytes >= INT_MAX) { + /* + * Note this gets -errorline as 1. Not worth figuring out which line + * crosses the limit to get -errorline for this error case. + */ + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("Script length %" TCL_SIZE_MODIFIER + "d exceeds max permitted length %d.", + numBytes, (int)INT_MAX-1)); + Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", NULL); + TclCompileSyntaxError(interp, envPtr); + return; + } /* * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so * many nested compilations (body enclosed in body) can cause abnormal diff --git a/generic/tclCompile.h b/generic/tclCompile.h index d82b8e3..22abb46 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1100,7 +1100,7 @@ MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, size_t numWords, CompileEnv *envPtr); MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp, - const char *script, size_t numBytes, + const char *script, Tcl_Size numBytes, CompileEnv *envPtr); MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp, CompileEnv *envPtr); diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 1839b12..2fa84c4 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -136,7 +136,7 @@ EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 33 */ EXTERN unsigned char * TclGetByteArrayFromObj(Tcl_Obj *objPtr, - int *numBytesPtr); + void *numBytesPtr); /* 34 */ EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr); @@ -156,7 +156,7 @@ EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp, /* 40 */ EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName); /* 41 */ -EXTERN char * TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); +EXTERN char * TclGetStringFromObj(Tcl_Obj *objPtr, void *lengthPtr); /* 42 */ EXTERN void Tcl_InvalidateStringRep(Tcl_Obj *objPtr); /* 43 */ @@ -167,7 +167,7 @@ EXTERN int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 45 */ EXTERN int TclListObjGetElements(Tcl_Interp *interp, - Tcl_Obj *listPtr, int *objcPtr, + Tcl_Obj *listPtr, void *objcPtr, Tcl_Obj ***objvPtr); /* 46 */ EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp, @@ -175,7 +175,7 @@ EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj **objPtrPtr); /* 47 */ EXTERN int TclListObjLength(Tcl_Interp *interp, - Tcl_Obj *listPtr, int *lengthPtr); + Tcl_Obj *listPtr, void *lengthPtr); /* 48 */ EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, @@ -665,9 +665,9 @@ EXTERN const char * Tcl_SignalMsg(int sig); EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp); /* 242 */ EXTERN int TclSplitList(Tcl_Interp *interp, const char *listStr, - int *argcPtr, const char ***argvPtr); + void *argcPtr, const char ***argvPtr); /* 243 */ -EXTERN void TclSplitPath(const char *path, int *argcPtr, +EXTERN void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr); /* Slot 244 is reserved */ /* Slot 245 is reserved */ @@ -1137,7 +1137,8 @@ EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, /* 433 */ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ -EXTERN Tcl_UniChar * TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); +EXTERN Tcl_UniChar * TclGetUnicodeFromObj(Tcl_Obj *objPtr, + void *lengthPtr); /* Slot 435 is reserved */ /* Slot 436 is reserved */ /* 437 */ @@ -1209,7 +1210,7 @@ EXTERN int Tcl_FSConvertToPathType(Tcl_Interp *interp, /* 460 */ EXTERN Tcl_Obj * Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements); /* 461 */ -EXTERN Tcl_Obj * TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr); +EXTERN Tcl_Obj * TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr); /* 462 */ EXTERN int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); @@ -1306,7 +1307,7 @@ EXTERN int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 497 */ EXTERN int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, - int *sizePtr); + void *sizePtr); /* 498 */ EXTERN int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, @@ -1612,7 +1613,7 @@ EXTERN int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 604 */ EXTERN int TclParseArgsObjv(Tcl_Interp *interp, - const Tcl_ArgvInfo *argTable, int *objcPtr, + const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 605 */ EXTERN int Tcl_GetErrorLine(Tcl_Interp *interp); @@ -1744,7 +1745,7 @@ EXTERN int * Tcl_UtfToUniCharDString(const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 649 */ EXTERN unsigned char * TclGetBytesFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, int *numBytesPtr); + Tcl_Obj *objPtr, void *numBytesPtr); /* 650 */ EXTERN unsigned char * Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); @@ -1912,7 +1913,7 @@ typedef struct TclStubs { void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */ int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *intPtr); /* 31 */ int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 32 */ - unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, int *numBytesPtr); /* 33 */ + unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, void *numBytesPtr); /* 33 */ int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */ int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */ void (*reserved36)(void); @@ -1920,13 +1921,13 @@ typedef struct TclStubs { int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */ const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ - char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */ + char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, void *lengthPtr); /* 41 */ void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */ int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */ int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */ - int (*tclListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */ + int (*tclListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, void *objcPtr, Tcl_Obj ***objvPtr); /* 45 */ int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, Tcl_Obj **objPtrPtr); /* 46 */ - int (*tclListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */ + int (*tclListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, void *lengthPtr); /* 47 */ int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, Tcl_Size count, Tcl_Size objc, Tcl_Obj *const objv[]); /* 48 */ void (*reserved49)(void); Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, Tcl_Size numBytes); /* 50 */ @@ -2121,8 +2122,8 @@ typedef struct TclStubs { const char * (*tcl_SignalId) (int sig); /* 239 */ const char * (*tcl_SignalMsg) (int sig); /* 240 */ void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */ - int (*tclSplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */ - void (*tclSplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */ + int (*tclSplitList) (Tcl_Interp *interp, const char *listStr, void *argcPtr, const char ***argvPtr); /* 242 */ + void (*tclSplitPath) (const char *path, void *argcPtr, const char ***argvPtr); /* 243 */ void (*reserved244)(void); void (*reserved245)(void); void (*reserved246)(void); @@ -2313,7 +2314,7 @@ typedef struct TclStubs { void * (*tcl_AttemptDbCkrealloc) (void *ptr, TCL_HASH_TYPE size, const char *file, int line); /* 431 */ int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, Tcl_Size length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ - Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ + Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, void *lengthPtr); /* 434 */ void (*reserved435)(void); void (*reserved436)(void); Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */ @@ -2340,7 +2341,7 @@ typedef struct TclStubs { int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */ int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */ Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, Tcl_Size elements); /* 460 */ - Tcl_Obj * (*tclFSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */ + Tcl_Obj * (*tclFSSplitPath) (Tcl_Obj *pathPtr, void *lenPtr); /* 461 */ int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */ Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */ Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, Tcl_Size objc, Tcl_Obj *const objv[]); /* 464 */ @@ -2376,7 +2377,7 @@ typedef struct TclStubs { int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */ int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */ int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */ - int (*tclDictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 497 */ + int (*tclDictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, void *sizePtr); /* 497 */ int (*tcl_DictObjFirst) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 498 */ void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */ void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr); /* 500 */ @@ -2483,7 +2484,7 @@ typedef struct TclStubs { unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */ int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */ int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */ - int (*tclParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */ + int (*tclParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */ int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */ void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */ void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 607 */ @@ -2528,7 +2529,7 @@ typedef struct TclStubs { Tcl_Size (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ char * (*tcl_UniCharToUtfDString) (const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 647 */ int * (*tcl_UtfToUniCharDString) (const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 648 */ - unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */ + unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void *numBytesPtr); /* 649 */ unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 650 */ char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 651 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 652 */ @@ -4042,15 +4043,15 @@ extern const TclStubs *tclStubsPtr; # if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) # define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (sizePtr)) : \ tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tclGetStringFromObj(objPtr, (sizePtr)) : \ tclStubsPtr->tcl_GetStringFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tclGetUnicodeFromObj(objPtr, (sizePtr)) : \ tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) # endif #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ @@ -4065,18 +4066,18 @@ extern const TclStubs *tclStubsPtr; #if TCL_MAJOR_VERSION > 8 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \ tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))) #else #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetByteArrayFromObj(objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tclGetByteArrayFromObj(objPtr, (sizePtr)) : \ tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) #endif #else #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - TclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ + TclGetBytesFromObj(interp, objPtr, (sizePtr)) : \ (Tcl_GetBytesFromObj)(interp, objPtr, (Tcl_Size *)(void *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \ @@ -4089,15 +4090,15 @@ extern const TclStubs *tclStubsPtr; Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - TclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ + TclGetStringFromObj(objPtr, (sizePtr)) : \ (Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr))) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - TclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \ + TclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \ (Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - TclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \ + TclGetUnicodeFromObj(objPtr, (sizePtr)) : \ (Tcl_GetUnicodeFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr))) #endif @@ -4173,31 +4174,31 @@ extern const TclStubs *tclStubsPtr; #if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) # undef Tcl_ListObjGetElements # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ - ? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ + ? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \ : tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr))) # undef Tcl_ListObjLength # define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \ - ? tclStubsPtr->tclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \ + ? tclStubsPtr->tclListObjLength((interp), (listPtr), (lengthPtr)) \ : tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr))) # undef Tcl_DictObjSize # define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \ - ? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \ + ? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (sizePtr)) \ : tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr))) # undef Tcl_SplitList # define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ - ? tclStubsPtr->tclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \ + ? tclStubsPtr->tclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \ : tclStubsPtr->tcl_SplitList((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # undef Tcl_SplitPath # define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ - ? tclStubsPtr->tclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \ + ? tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr)) \ : tclStubsPtr->tcl_SplitPath((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # undef Tcl_FSSplitPath # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \ - ? tclStubsPtr->tclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \ + ? tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) \ : tclStubsPtr->tcl_FSSplitPath((pathPtr), (Tcl_Size *)(void *)(lenPtr))) # undef Tcl_ParseArgsObjv # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \ - ? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ + ? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \ : tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) #endif /* TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) */ #else @@ -4215,25 +4216,25 @@ extern const TclStubs *tclStubsPtr; : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) #if !defined(BUILD_tcl) && !defined(TCL_NO_DEPRECATED) # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ - ? TclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ + ? TclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \ : (Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr))) # define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \ - ? TclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \ + ? TclListObjLength((interp), (listPtr), (lengthPtr)) \ : (Tcl_ListObjLength)((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr))) # define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \ - ? TclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \ + ? TclDictObjSize((interp), (dictPtr), (sizePtr)) \ : (Tcl_DictObjSize)((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ - ? TclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \ + ? TclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \ : (Tcl_SplitList)((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ - ? TclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \ + ? TclSplitPath((path), (argcPtr), (argvPtr)) \ : (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \ - ? TclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \ + ? TclFSSplitPath((pathPtr), (lenPtr)) \ : (Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(void *)(lenPtr))) # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \ - ? TclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ + ? TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \ : (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) #endif /* !defined(BUILD_tcl) */ #endif diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 4efb86f..d13c923 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -200,10 +200,10 @@ static struct TclEncodingProfiles { {"tcl8", TCL_ENCODING_PROFILE_TCL8}, }; #define PROFILE_STRICT(flags_) \ - (CHANNEL_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_STRICT) + (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_STRICT) #define PROFILE_REPLACE(flags_) \ - (CHANNEL_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) + (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) #define UNICODE_REPLACE_CHAR ((Tcl_UniChar)0xFFFD) #define SURROGATE(c_) (((c_) & ~0x7FF) == 0xD800) @@ -2517,7 +2517,7 @@ UtfToUtfProc( flags |= PTR2INT(clientData); dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6); - profile = CHANNEL_PROFILE_GET(flags); + profile = ENCODING_PROFILE_GET(flags); for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 31a8695..647e3db 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -981,10 +981,10 @@ GrowEvaluationStack( { ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL; size_t newBytes; - int growth = growth1; - int newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr); + Tcl_Size growth = growth1; + Tcl_Size newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr); Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart; - int moveWords = 0; + Tcl_Size moveWords = 0; if (move) { if (!markerPtr) { @@ -2825,8 +2825,12 @@ TEBCresume( pc += pcAdjustment; TEBC_YIELD(); - return TclNREvalObjv(interp, objc, objv, + if (objc > INT_MAX) { + return TclCommandWordLimitError(interp, objc); + } else { + return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL); + } case INST_INVOKE_REPLACE: objc = TclGetUInt4AtPtr(pc+1); @@ -5272,7 +5276,7 @@ TEBCresume( TclNewObj(objResultPtr); } else if (TclIsPureByteArray(valuePtr)) { objResultPtr = Tcl_NewByteArrayObj( - Tcl_GetByteArrayFromObj(valuePtr, (size_t *)NULL)+index, 1); + Tcl_GetByteArrayFromObj(valuePtr, (Tcl_Size *)NULL)+index, 1); } else if (valuePtr->bytes && slength == valuePtr->length) { objResultPtr = Tcl_NewStringObj((const char *) valuePtr->bytes+index, 1); @@ -5488,7 +5492,7 @@ TEBCresume( NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: - objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1); + objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, TCL_SIZE_MAX - 1); TRACE(("%.20s %.20s => %s\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr))); @@ -5536,7 +5540,7 @@ TEBCresume( nocase); } else if (TclIsPureByteArray(valuePtr) && TclIsPureByteArray(value2Ptr) && !nocase) { unsigned char *bytes1, *bytes2; - size_t wlen1 = 0, wlen2 = 0; + Tcl_Size wlen1 = 0, wlen2 = 0; bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &wlen1); bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &wlen2); diff --git a/generic/tclIO.c b/generic/tclIO.c index bd85c05..e7e5b1b 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -1679,10 +1679,10 @@ Tcl_CreateChannel( statePtr->encoding = Tcl_GetEncoding(NULL, name); statePtr->inputEncodingState = NULL; statePtr->inputEncodingFlags = TCL_ENCODING_START; - CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, 0); + ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, 0); statePtr->outputEncodingState = NULL; statePtr->outputEncodingFlags = TCL_ENCODING_START; - CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, 0); + ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, 0); /* * Set the channel up initially in AUTO input translation mode to accept @@ -8008,7 +8008,7 @@ Tcl_GetChannelOption( Tcl_DStringAppendElement(dsPtr, "-profile"); } /* Note currently input and output profiles are same */ - profile = CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags); + profile = ENCODING_PROFILE_GET(statePtr->inputEncodingFlags); profileName = TclEncodingProfileIdToName(interp, profile); if (profileName == NULL) { return TCL_ERROR; @@ -8203,11 +8203,11 @@ Tcl_SetChannelOption( if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) { encoding = Tcl_GetEncoding(NULL, "iso8859-1"); - CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags - ,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags) + ENCODING_PROFILE_SET(statePtr->inputEncodingFlags + ,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags) |TCL_ENCODING_PROFILE_STRICT); - CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags - ,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags) + ENCODING_PROFILE_SET(statePtr->outputEncodingFlags + ,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags) |TCL_ENCODING_PROFILE_STRICT); } else { encoding = Tcl_GetEncoding(interp, newValue); @@ -8230,12 +8230,12 @@ Tcl_SetChannelOption( Tcl_FreeEncoding(statePtr->encoding); statePtr->encoding = encoding; statePtr->inputEncodingState = NULL; - profile = CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags); + profile = ENCODING_PROFILE_GET(statePtr->inputEncodingFlags); statePtr->inputEncodingFlags = TCL_ENCODING_START; - CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, profile); + ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, profile); statePtr->outputEncodingState = NULL; statePtr->outputEncodingFlags = TCL_ENCODING_START; - CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, profile); /* Same as input */ + ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, profile); /* Same as input */ ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA|CHANNEL_ENCODING_ERROR); UpdateInterest(chanPtr); return TCL_OK; @@ -8278,8 +8278,8 @@ Tcl_SetChannelOption( if (TclEncodingProfileNameToId(interp, newValue, &profile) != TCL_OK) { return TCL_ERROR; } - CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, profile); - CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, profile); + ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, profile); + ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, profile); ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA|CHANNEL_ENCODING_ERROR); return TCL_OK; } else if (HaveOpt(1, "-translation")) { @@ -8317,11 +8317,11 @@ Tcl_SetChannelOption( statePtr->inEofChar = 0; Tcl_FreeEncoding(statePtr->encoding); statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1"); - CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags - ,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags) + ENCODING_PROFILE_SET(statePtr->inputEncodingFlags + ,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags) |TCL_ENCODING_PROFILE_STRICT); - CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags - ,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags) + ENCODING_PROFILE_SET(statePtr->outputEncodingFlags + ,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags) |TCL_ENCODING_PROFILE_STRICT); } else if (strcmp(readMode, "lf") == 0) { translation = TCL_TRANSLATE_LF; @@ -8372,11 +8372,11 @@ Tcl_SetChannelOption( statePtr->outputTranslation = TCL_TRANSLATE_LF; Tcl_FreeEncoding(statePtr->encoding); statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1"); - CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags - ,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags) + ENCODING_PROFILE_SET(statePtr->inputEncodingFlags + ,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags) |TCL_ENCODING_PROFILE_STRICT); - CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags - ,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags) + ENCODING_PROFILE_SET(statePtr->outputEncodingFlags + ,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags) |TCL_ENCODING_PROFILE_STRICT); } else if (strcmp(writeMode, "lf") == 0) { statePtr->outputTranslation = TCL_TRANSLATE_LF; @@ -10304,8 +10304,8 @@ Lossless( ( toRead == -1 && inStatePtr->encoding == outStatePtr->encoding - && CHANNEL_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 - && CHANNEL_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 + && ENCODING_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 + && ENCODING_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 ) ); } diff --git a/generic/tclIO.h b/generic/tclIO.h index 6b166b0..145296a 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -288,13 +288,6 @@ typedef struct ChannelState { #define CHANNEL_CLOSEDWRITE (1<<21) /* Channel write side has been closed. * No further Tcl-level write IO on * the channel is allowed. */ -#define CHANNEL_PROFILE_MASK 0xFF000000 -#define CHANNEL_PROFILE_GET(flags_) ((flags_) & CHANNEL_PROFILE_MASK) -#define CHANNEL_PROFILE_SET(flags_, profile_) \ - do { \ - (flags_) &= ~CHANNEL_PROFILE_MASK; \ - (flags_) |= profile_; \ - } while (0) /* * The length of time to wait between synthetic timer events. Must be zero or diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 1290ac7..98a1dd3 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -375,7 +375,7 @@ ExecuteCallback( * interpreters. */ { Tcl_Obj *resObj; /* See below, switch (transmit). */ - size_t resLen = 0; + Tcl_Size resLen = 0; unsigned char *resBuf; Tcl_InterpState state = NULL; int res = TCL_OK; diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 3c54366..90e7195 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -264,7 +264,7 @@ struct ForwardParamTransform { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* I: Bytes to transform, * O: Bytes in transform result */ - size_t size; /* I: #bytes to transform, + Tcl_Size size; /* I: #bytes to transform, * O: #bytes in the transform result */ }; struct ForwardParamLimit { @@ -2562,7 +2562,7 @@ ForwardProc( * Sent it back to the request originator. */ - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ @@ -2596,7 +2596,7 @@ ForwardProc( * Sent it back to the request originator. */ - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ @@ -2626,7 +2626,7 @@ ForwardProc( * Sent it back to the request originator. */ - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); @@ -2652,7 +2652,7 @@ ForwardProc( * Sent it back to the request originator. */ - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ @@ -3045,7 +3045,7 @@ TransformRead( Tcl_Obj *bufObj) { Tcl_Obj *resObj; - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ /* @@ -3100,7 +3100,7 @@ TransformWrite( { Tcl_Obj *bufObj; Tcl_Obj *resObj; - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ int res; @@ -3167,7 +3167,7 @@ TransformDrain( int *errorCodePtr) { Tcl_Obj *resObj; - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ /* @@ -3216,7 +3216,7 @@ TransformFlush( int op) { Tcl_Obj *resObj; - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ int res; diff --git a/generic/tclInt.h b/generic/tclInt.h index 6456f8f..436384e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2451,16 +2451,6 @@ typedef enum TclEolTranslation { #define TCL_INVOKE_NO_UNKNOWN (1<<1) #define TCL_INVOKE_NO_TRACEBACK (1<<2) -#if TCL_MAJOR_VERSION > 8 -/* - * SSIZE_MAX, NOT SIZE_MAX as negative differences need to be expressed - * between values of the Tcl_Size type so limit the range to signed - */ -# define ListSizeT_MAX ((Tcl_Size)PTRDIFF_MAX) -#else -# define ListSizeT_MAX INT_MAX -#endif - /* * ListStore -- * @@ -2501,7 +2491,8 @@ typedef struct ListStore { /* Max number of elements that can be contained in a list */ #define LIST_MAX \ - ((Tcl_Size)((ListSizeT_MAX - offsetof(ListStore, slots)) / sizeof(Tcl_Obj *))) + ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \ + / sizeof(Tcl_Obj *))) /* Memory size needed for a ListStore to hold numSlots_ elements */ #define LIST_SIZE(numSlots_) \ ((Tcl_Size)(offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *)))) @@ -2864,6 +2855,22 @@ typedef struct ProcessGlobalValue { #define TCL_PARSE_NO_UNDERSCORE 128 /* Reject underscore digit separator */ + +/* + *---------------------------------------------------------------------- + * Internal convenience macros for manipulating encoding flags. See + * TCL_ENCODING_PROFILE_* in tcl.h + *---------------------------------------------------------------------- + */ + +#define ENCODING_PROFILE_MASK 0xFF000000 +#define ENCODING_PROFILE_GET(flags_) ((flags_) & ENCODING_PROFILE_MASK) +#define ENCODING_PROFILE_SET(flags_, profile_) \ + do { \ + (flags_) &= ~ENCODING_PROFILE_MASK; \ + (flags_) |= profile_; \ + } while (0) + /* *---------------------------------------------------------------- * Variables shared among Tcl modules but not used by the outside world. @@ -3385,7 +3392,7 @@ MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, int checkEq, int nocase, Tcl_Size reqlength); MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int *nocase, - int *reqlength); + Tcl_Size *reqlength); MODULE_SCOPE int TclStringMatch(const char *str, Tcl_Size strLen, const char *pattern, int ptnLen, int flags); MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, @@ -4172,6 +4179,12 @@ MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, MODULE_SCOPE Tcl_Size TclIndexDecode(int encoded, Tcl_Size endValue); MODULE_SCOPE int TclIndexInvalidError(Tcl_Interp *interp, const char *idxType, Tcl_Size idx); + +/* + * Error message utility functions + */ +MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count); + #endif /* TCL_MAJOR_VERSION > 8 */ /* Constants used in index value encoding routines. */ diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 6d3b587..87530be 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -850,7 +850,19 @@ ListStoreReallocate (ListStore *storePtr, Tcl_Size numSlots) newCapacity = ListStoreUpSize(numSlots); newStorePtr = (ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity)); + + /* + * In case above failed keep looping reducing the requested extra space + * by half every time. + */ + while (newStorePtr == NULL && (newCapacity > (numSlots+1))) { + /* Because of loop condition newCapacity can't overflow */ + newCapacity = numSlots + ((newCapacity - numSlots) / 2); + newStorePtr = + (ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity)); + } if (newStorePtr == NULL) { + /* Last resort - allcate what was asked */ newCapacity = numSlots; newStorePtr = (ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity)); @@ -2110,12 +2122,12 @@ Tcl_ListObjReplace( } if (numToDelete < 0) { numToDelete = 0; - } else if (first > ListSizeT_MAX - numToDelete /* Handle integer overflow */ + } else if (first > LIST_MAX - numToDelete /* Handle integer overflow */ || origListLen < first + numToDelete) { numToDelete = origListLen - first; } - if (numToInsert > ListSizeT_MAX - (origListLen - numToDelete)) { + if (numToInsert > LIST_MAX - (origListLen - numToDelete)) { return ListLimitExceededError(interp); } @@ -2576,7 +2588,7 @@ TclLindexList( * see TIP#22 and TIP#33 for the details. */ if (!TclHasInternalRep(argObj, &tclListType.objType) - && TclGetIntForIndexM(NULL, argObj, ListSizeT_MAX - 1, &index) + && TclGetIntForIndexM(NULL, argObj, TCL_SIZE_MAX - 1, &index) == TCL_OK) { /* * argPtr designates a single index. @@ -2702,7 +2714,7 @@ TclLindexFlat( while (++i < indexCount) { if (TclGetIntForIndexM( - interp, indexArray[i], ListSizeT_MAX - 1, &index) + interp, indexArray[i], TCL_SIZE_MAX - 1, &index) != TCL_OK) { Tcl_DecrRefCount(sublistCopy); return NULL; @@ -2767,7 +2779,7 @@ TclLsetList( */ if (!TclHasInternalRep(indexArgObj, &tclListType.objType) - && TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index) + && TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index) == TCL_OK) { /* indexArgPtr designates a single index. */ /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */ diff --git a/generic/tclObj.c b/generic/tclObj.c index a978a09..0c9c405 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1670,7 +1670,7 @@ char * TclGetStringFromObj( Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ - int *lengthPtr) /* If non-NULL, the location where the string + void *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { @@ -1702,9 +1702,9 @@ TclGetStringFromObj( if (lengthPtr != NULL) { if (objPtr->length > INT_MAX) { Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr" - " cannot handle such long strings. Please use 'size_t'"); + " cannot handle such long strings. Please use 'Tcl_Size'"); } - *lengthPtr = (int)objPtr->length; + *(int *)lengthPtr = (int)objPtr->length; } return objPtr->bytes; } diff --git a/generic/tclParse.c b/generic/tclParse.c index 96f8a8e..d8b40e4 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -214,7 +214,7 @@ Tcl_ParseCommand( * command. */ char type; /* Result returned by CHAR_TYPE(*src). */ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ - int wordIndex; /* Index of word token for current word. */ + Tcl_Size wordIndex; /* Index of word token for current word. */ int terminators; /* CHAR_TYPE bits that indicate the end of a * command. */ const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to @@ -327,7 +327,7 @@ Tcl_ParseCommand( src = termPtr; numBytes = parsePtr->end - src; } else if (*src == '{') { - int expIdx = wordIndex + 1; + Tcl_Size expIdx = wordIndex + 1; Tcl_Token *expPtr; if (Tcl_ParseBraces(interp, src, numBytes, parsePtr, 1, @@ -345,7 +345,7 @@ Tcl_ParseCommand( expPtr = &parsePtr->tokenPtr[expIdx]; if ((0 == expandWord) /* Haven't seen prefix already */ - && (expIdx + 1 == (int)parsePtr->numTokens) + && (expIdx + 1 == parsePtr->numTokens) /* Only one token */ && (((1 == expPtr->size) /* Same length as prefix */ @@ -380,7 +380,7 @@ Tcl_ParseCommand( tokenPtr = &parsePtr->tokenPtr[wordIndex]; tokenPtr->size = src - tokenPtr->start; - tokenPtr->numComponents = (int)parsePtr->numTokens - (wordIndex + 1); + tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1); if (expandWord) { Tcl_Size i; int isLiteral = 1; @@ -407,7 +407,8 @@ Tcl_ParseCommand( } if (isLiteral) { - int elemCount = 0, code = TCL_OK, literal = 1; + Tcl_Size elemCount = 0; + int code = TCL_OK, literal = 1; const char *nextElem, *listEnd, *elemStart; /* @@ -471,8 +472,8 @@ Tcl_ParseCommand( */ const char *listStart; - int growthNeeded = wordIndex + 2*elemCount - - (int)parsePtr->numTokens; + Tcl_Size growthNeeded = wordIndex + 2*elemCount + - parsePtr->numTokens; parsePtr->numWords += elemCount - 1; if (growthNeeded > 0) { diff --git a/generic/tclScan.c b/generic/tclScan.c index ee18174..b7bd94a 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -11,6 +11,7 @@ #include "tclInt.h" #include "tclTomMath.h" +#include <assert.h> /* * Flag values used by Tcl_ScanObjCmd. @@ -258,7 +259,7 @@ ValidateFormat( int *totalSubs) /* The number of variables that will be * required. */ { - int gotXpg, gotSequential, value, i, flags; + int gotXpg, gotSequential, i, flags; char *end; Tcl_UniChar ch = 0; int objIndex, xpgSize, nspace = numVars; @@ -306,7 +307,8 @@ ValidateFormat( * format string. */ - value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ + /* assert(value is >= 0) because of the isdigit() check above */ + unsigned long long ull = strtoull(format-1, &end, 10); /* INTL: "C" locale. */ if (*end != '$') { goto notXpg; } @@ -316,17 +318,22 @@ ValidateFormat( if (gotSequential) { goto mixedXPG; } - objIndex = value - 1; - if ((objIndex < 0) || (numVars && (objIndex >= numVars))) { + /* >=INT_MAX because 9.0 does not support more than INT_MAX-1 args */ + if (ull == 0 || ull >= INT_MAX) { goto badIndex; - } else if (numVars == 0) { + } + objIndex = (int) ull - 1; + if (numVars && (objIndex >= numVars)) { + goto badIndex; + } + else if (numVars == 0) { /* * In the case where no vars are specified, the user can * specify %9999$ legally, so we have to consider special - * rules for growing the assign array. 'value' is guaranteed - * to be > 0. + * rules for growing the assign array. 'ull' is guaranteed + * to be > 0 and < INT_MAX as per checks above. */ - xpgSize = (xpgSize > value) ? xpgSize : value; + xpgSize = (xpgSize > (int)ull) ? xpgSize : (int)ull; } goto xpgCheckDone; } @@ -348,7 +355,22 @@ ValidateFormat( */ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ - value = strtoul(format-1, (char **) &format, 10); /* INTL: "C" locale. */ + /* Note ull >= 0 because of isdigit check above */ + unsigned long long ull; + ull = strtoull( + format - 1, (char **)&format, 10); /* INTL: "C" locale. */ + /* Note >=, not >, to leave room for a nul */ + if (ull >= TCL_SIZE_MAX) { + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("specified field width %" TCL_LL_MODIFIER + "u exceeds limit %" TCL_SIZE_MODIFIER "d.", + ull, + (Tcl_Size)TCL_SIZE_MAX-1)); + Tcl_SetErrorCode( + interp, "TCL", "FORMAT", "WIDTHLIMIT", NULL); + goto error; + } flags |= SCAN_WIDTH; format += TclUtfToUniChar(format, &ch); } @@ -473,7 +495,7 @@ ValidateFormat( * guaranteed to be at least one larger than objIndex. */ - value = nspace; + int nspaceOrig = nspace; if (xpgSize) { nspace = xpgSize; } else { @@ -481,7 +503,7 @@ ValidateFormat( } nassign = (int *)TclStackRealloc(interp, nassign, nspace * sizeof(int)); - for (i = value; i < nspace; i++) { + for (i = nspaceOrig; i < nspace; i++) { nassign[i] = 0; } } @@ -575,7 +597,8 @@ Tcl_ScanObjCmd( long value; const char *string, *end, *baseString; char op = 0; - int width, underflow = 0; + int underflow = 0; + Tcl_Size width; Tcl_WideInt wideValue; Tcl_UniChar ch = 0, sch = 0; Tcl_Obj **objs = NULL, *objPtr = NULL; @@ -670,6 +693,7 @@ Tcl_ScanObjCmd( format += TclUtfToUniChar(format, &ch); } else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ char *formatEnd; + /* Note currently XPG3 range limited to INT_MAX to match type of objc */ value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */ if (*formatEnd == '$') { format = formatEnd+1; @@ -683,7 +707,10 @@ Tcl_ScanObjCmd( */ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ - width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */ + unsigned long long ull; + ull = strtoull(format-1, (char **) &format, 10); /* INTL: "C" locale. */ + assert(ull <= TCL_SIZE_MAX); /* Else ValidateFormat should've error'ed */ + width = (Tcl_Size)ull; format += TclUtfToUniChar(format, &ch); } else { width = 0; @@ -1067,12 +1094,15 @@ Tcl_ScanObjCmd( } else { /* * Here no vars were specified, we want a list returned (inline scan) + * We create an empty Tcl_Obj to fill missing values rather than + * allocating a new Tcl_Obj every time. See test scan-bigdata-XX. */ - + Tcl_Obj *emptyObj = Tcl_NewObj(); + Tcl_IncrRefCount(emptyObj); TclNewObj(objPtr); - for (i = 0; i < totalVars; i++) { + for (i = 0; code == TCL_OK && i < totalVars; i++) { if (objs[i] != NULL) { - Tcl_ListObjAppendElement(NULL, objPtr, objs[i]); + code = Tcl_ListObjAppendElement(interp, objPtr, objs[i]); Tcl_DecrRefCount(objs[i]); } else { /* @@ -1080,8 +1110,19 @@ Tcl_ScanObjCmd( * empty strings for these. */ - Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj()); + code = Tcl_ListObjAppendElement(interp, objPtr, emptyObj); + } + } + Tcl_DecrRefCount(emptyObj); + if (code != TCL_OK) { + /* If error'ed out, free up remaining. i contains last index freed */ + while (++i < totalVars) { + if (objs[i] != NULL) { + Tcl_DecrRefCount(objs[i]); + } } + Tcl_DecrRefCount(objPtr); + objPtr = NULL; } } if (objs != NULL) { diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 2bbc4bc..63e38bb 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -515,6 +515,11 @@ TclCheckEmptyString( return TCL_EMPTYSTRING_YES; } + if (TclIsPureByteArray(objPtr) + && Tcl_GetCharLength(objPtr) == 0) { + return TCL_EMPTYSTRING_YES; + } + if (TclListObjIsCanonical(objPtr)) { TclListObjLengthM(NULL, objPtr, &length); return length == 0; @@ -685,7 +690,7 @@ Tcl_UniChar * TclGetUnicodeFromObj( Tcl_Obj *objPtr, /* The object to find the Unicode string * for. */ - int *lengthPtr) /* If non-NULL, the location where the string + void *lengthPtr) /* If non-NULL, the location where the string * rep's Tcl_UniChar length should be stored. If * NULL, no length is stored. */ { @@ -704,7 +709,7 @@ TclGetUnicodeFromObj( Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr" " cannot handle such long strings. Please use 'Tcl_Size'"); } - *lengthPtr = (int)stringPtr->numChars; + *(int *)lengthPtr = (int)stringPtr->numChars; } return stringPtr->unicode; } @@ -1431,26 +1436,26 @@ Tcl_AppendObjToObj( Tcl_Size appendNumChars = TCL_INDEX_NONE; const char *bytes; - /* - * Special case: second object is standard-empty is fast case. We know - * that appending nothing to anything leaves that starting anything... - */ + if (TclCheckEmptyString(appendObjPtr) == TCL_EMPTYSTRING_YES) { + return; + } - if (appendObjPtr->bytes == &tclEmptyString) { + if (TclCheckEmptyString(objPtr) == TCL_EMPTYSTRING_YES) { + TclSetDuplicateObj(objPtr, appendObjPtr); return; } - /* - * Handle append of one ByteArray object to another as a special case. - * Note that we only do this when the objects are pure so that the - * bytearray faithfully represent the true value; Otherwise appending the - * byte arrays together could lose information; - */ + if ( + TclIsPureByteArray(appendObjPtr) + && (TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString) + ) { + /* + * Both bytearray objects are pure, so the second internal bytearray value + * can be appended to the first, with no need to modify the "bytes" field. + */ - if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString) - && TclIsPureByteArray(appendObjPtr)) { /* - * You might expect the code here to be + * One might expect the code here to be * * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length); * TclAppendBytesToByteArray(objPtr, bytes, length); @@ -2006,12 +2011,16 @@ Tcl_AppendFormatToObj( width = 0; if (isdigit(UCHAR(ch))) { - width = strtoul(format, &end, 10); - if (width < 0) { + /* Note ull will be >= 0 because of isdigit check above */ + unsigned long long ull; + ull = strtoull(format, &end, 10); + /* Comparison is >=, not >, to leave room for nul */ + if (ull >= TCL_SIZE_MAX) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } + width = (Tcl_Size)ull; format = end; step = TclUtfToUniChar(format, &ch); } else if (ch == '*') { @@ -2048,7 +2057,16 @@ Tcl_AppendFormatToObj( step = TclUtfToUniChar(format, &ch); } if (isdigit(UCHAR(ch))) { - precision = strtoul(format, &end, 10); + /* Note ull will be >= 0 because of isdigit check above */ + unsigned long long ull; + ull = strtoull(format, &end, 10); + /* Comparison is >=, not >, to leave room for nul */ + if (ull >= TCL_SIZE_MAX) { + msg = overflow; + errCode = "OVERFLOW"; + goto errorMsg; + } + precision = (Tcl_Size)ull; format = end; step = TclUtfToUniChar(format, &ch); } else if (ch == '*') { @@ -3126,7 +3144,7 @@ TclStringCat( int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0; Tcl_Size first = objc - 1; /* Index of first value possibly not empty */ Tcl_Size last = 0; /* Index of last value possibly not empty */ - int inPlace = flags & TCL_STRING_IN_PLACE; + int inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv); /* assert ( objc >= 0 ) */ @@ -3254,7 +3272,8 @@ TclStringCat( Tcl_Obj *objPtr = *ov++; - if (objPtr->bytes == NULL) { + if (objPtr->bytes == NULL + && TclCheckEmptyString(objPtr) != TCL_EMPTYSTRING_YES) { /* No string rep; Take the chance we can avoid making it */ pendingPtr = objPtr; } else { @@ -3330,6 +3349,7 @@ TclStringCat( } objv += first; objc = (last - first + 1); + inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv); if (binary) { /* Efficiently produce a pure byte array result */ @@ -3340,7 +3360,7 @@ TclStringCat( * failure to allocate enough space. Following stanza may panic. */ - if (inPlace && !Tcl_IsShared(*objv)) { + if (inPlace) { Tcl_Size start = 0; objResultPtr = *objv++; objc--; @@ -3370,7 +3390,7 @@ TclStringCat( /* Efficiently produce a pure Tcl_UniChar array result */ Tcl_UniChar *dst; - if (inPlace && !Tcl_IsShared(*objv)) { + if (inPlace) { Tcl_Size start; objResultPtr = *objv++; objc--; @@ -3421,7 +3441,7 @@ TclStringCat( /* Efficiently concatenate string reps */ char *dst; - if (inPlace && !Tcl_IsShared(*objv)) { + if (inPlace) { Tcl_Size start; objResultPtr = *objv++; objc--; @@ -3512,6 +3532,7 @@ TclStringCmp( if ((reqlength == 0) || (value1Ptr == value2Ptr)) { /* * Always match at 0 chars of if it is the same obj. + * Note: as documented reqlength negative means it is ignored */ match = 0; } else { @@ -3566,7 +3587,7 @@ TclStringCmp( memCmpFn = memcmp; s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); - if (reqlength != TCL_INDEX_NONE) { + if (reqlength > 0) { reqlength *= sizeof(Tcl_UniChar); } } else { @@ -3610,7 +3631,7 @@ TclStringCmp( s1 = Tcl_GetStringFromObj(value1Ptr, &s1len); s2 = Tcl_GetStringFromObj(value2Ptr, &s2len); } - if (!nocase && checkEq && reqlength == TCL_INDEX_NONE) { + if (!nocase && checkEq && reqlength < 0) { /* * When we have equal-length we can check only for * (in)equality. We can use memcmp in all (n)eq cases because @@ -3627,7 +3648,7 @@ TclStringCmp( * length was requested. */ - if ((reqlength == TCL_INDEX_NONE) && !nocase) { + if ((reqlength < 0) && !nocase) { memCmpFn = (memCmpFn_t) TclpUtfNcmp2; } else { s1len = Tcl_NumUtfChars(s1, s1len); @@ -3643,7 +3664,7 @@ TclStringCmp( * comparison function. */ length = (s1len < s2len) ? s1len : s2len; - if (reqlength == TCL_INDEX_NONE) { + if (reqlength < 0) { /* * The requested length is negative, so ignore it by setting it * to length + 1 to correct the match var. @@ -3654,7 +3675,7 @@ TclStringCmp( length = reqlength; } - if (checkEq && reqlength == TCL_INDEX_NONE && (s1len != s2len)) { + if (checkEq && reqlength < 0 && (s1len != s2len)) { match = 1; /* This will be reversed below. */ } else { /* @@ -4483,6 +4504,14 @@ ExtendStringRepWithUnicode( copyBytes: dst = objPtr->bytes + origLength; +#if TCL_UTF_MAX < 4 + /* Initialize the buffer so that some random data doesn't trick + * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs. + * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its + * prior non-stateful nature, this call to memset can also be removed. + */ + memset(dst, 0xff, stringPtr->allocated - origLength); +#endif for (i = 0; i < numChars; i++) { dst += Tcl_UniCharToUtf(unicode[i], dst); } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ea0e195..a77a958 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -123,7 +123,7 @@ static void uniCodePanic() { # define TclParseArgsObjv 0 #else /* !defined(TCL_NO_DEPRECATED) */ int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, - int *objcPtr, Tcl_Obj ***objvPtr) { + void *objcPtr, Tcl_Obj ***objvPtr) { Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr); if (objcPtr) { @@ -133,12 +133,12 @@ int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, } return TCL_ERROR; } - *objcPtr = n; + *(int *)objcPtr = (int)n; } return result; } int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, - int *lengthPtr) { + void *lengthPtr) { Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_ListObjLength(interp, listPtr, &n); if (lengthPtr) { @@ -148,12 +148,12 @@ int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, } return TCL_ERROR; } - *lengthPtr = n; + *(int *)lengthPtr = (int)n; } return result; } int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, - int *sizePtr) { + void *sizePtr) { Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_DictObjSize(interp, dictPtr, &n); if (sizePtr) { @@ -163,11 +163,11 @@ int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, } return TCL_ERROR; } - *sizePtr = n; + *(int *)sizePtr = (int)n; } return result; } -int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, +int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr, const char ***argvPtr) { Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_SplitList(interp, listStr, &n, argvPtr); @@ -179,11 +179,11 @@ int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, Tcl_Free((void *)*argvPtr); return TCL_ERROR; } - *argcPtr = n; + *(int *)argcPtr = (int)n; } return result; } -void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr) { +void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) { Tcl_Size n = TCL_INDEX_NONE; Tcl_SplitPath(path, &n, argvPtr); if (argcPtr) { @@ -192,10 +192,10 @@ void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr) { Tcl_Free((void *)*argvPtr); *argvPtr = NULL; } - *argcPtr = n; + *(int *)argcPtr = (int)n; } } -Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) { +Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) { Tcl_Size n = TCL_INDEX_NONE; Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n); if (lenPtr) { @@ -203,16 +203,16 @@ Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) { Tcl_DecrRefCount(result); return NULL; } - *lenPtr = n; + *(int *)lenPtr = (int)n; } return result; } int TclParseArgsObjv(Tcl_Interp *interp, - const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, + const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) { - Tcl_Size n = (*objcPtr < 0) ? TCL_INDEX_NONE: *objcPtr ; + Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ; int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv); - *objcPtr = (int)n; + *(int *)objcPtr = (int)n; return result; } #endif /* !defined(TCL_NO_DEPRECATED) */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 9388110..b35abe0 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -224,7 +224,8 @@ static Tcl_ObjCmdProc TestbytestringObjCmd; static Tcl_ObjCmdProc TestsetbytearraylengthObjCmd; static Tcl_ObjCmdProc TestpurebytesobjObjCmd; static Tcl_ObjCmdProc TeststringbytesObjCmd; -static Tcl_CmdProc TestcmdinfoCmd; +static Tcl_ObjCmdProc2 Testcmdobj2ObjCmd; +static Tcl_ObjCmdProc TestcmdinfoObjCmd; static Tcl_CmdProc TestcmdtokenCmd; static Tcl_CmdProc TestcmdtraceCmd; static Tcl_CmdProc TestconcatobjCmd; @@ -586,7 +587,9 @@ Tcltest_Init( NULL, NULL); Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL, + Tcl_CreateObjCommand2(interp, "testcmdobj2", Testcmdobj2ObjCmd, + NULL, NULL); + Tcl_CreateObjCommand(interp, "testcmdinfo", TestcmdinfoObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd, NULL, NULL); @@ -1061,7 +1064,41 @@ TestbumpinterpepochObjCmd( /* *---------------------------------------------------------------------- * - * TestcmdinfoCmd -- + * Testcmdobj2 -- + * + * Mock up to test the Tcl_CreateCommandObj2 functionality + * + * Results: + * Standard Tcl result. + * + * Side effects: + * Sets interpreter result to number of arguments, first arg, last arg. + * + *---------------------------------------------------------------------- + */ + +static int +Testcmdobj2ObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Size objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tcl_Obj *resultObj; + resultObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewWideIntObj(objc)); + if (objc > 1) { + Tcl_ListObjAppendElement(interp, resultObj, objv[1]); + Tcl_ListObjAppendElement(interp, resultObj, objv[objc-1]); + } + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestcmdinfoObjCmd -- * * This procedure implements the "testcmdinfo" command. It is used to * test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation and @@ -1077,28 +1114,69 @@ TestbumpinterpepochObjCmd( */ static int -TestcmdinfoCmd( +TestcmdinfoObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { + static const char *const subcmds[] = { + "call", "call2", "create", "delete", "get", "modify", NULL + }; + enum options { + CMDINFO_CALL, CMDINFO_CALL2, CMDINFO_CREATE, + CMDINFO_DELETE, CMDINFO_GET, CMDINFO_MODIFY + } idx; Tcl_CmdInfo info; + Tcl_Obj **cmdObjv; + Tcl_Size cmdObjc; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option cmdName\"", NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "command arg"); return TCL_ERROR; } - if (strcmp(argv[1], "create") == 0) { - Tcl_CreateCommand(interp, argv[2], CmdProc1, (void *) "original", - CmdDelProc1); - } else if (strcmp(argv[1], "delete") == 0) { + if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0, + &idx) != TCL_OK) { + return TCL_ERROR; + } + switch (idx) { + case CMDINFO_CALL: + case CMDINFO_CALL2: + if (Tcl_ListObjGetElements(interp, objv[2], &cmdObjc, &cmdObjv) != TCL_OK) { + return TCL_ERROR; + } + if (cmdObjc == 0) { + Tcl_AppendResult(interp, "No command name given", NULL); + return TCL_ERROR; + } + if (Tcl_GetCommandInfo(interp, Tcl_GetString(cmdObjv[0]), &info) == 0) { + return TCL_ERROR; + } + if (idx == CMDINFO_CALL) { + /* + * Note when calling through the old 32-bit API, it is the caller's + * responsibility to check that number of arguments is <= INT_MAX. + * We do not do that here just so we can test what happens if the + * caller mistakenly passes more arguments. + */ + return info.objProc(info.objClientData, interp, cmdObjc, cmdObjv); + } else { + return info.objProc2(info.objClientData2, interp, cmdObjc, cmdObjv); + } + case CMDINFO_CREATE: + Tcl_CreateCommand(interp, + Tcl_GetString(objv[2]), + CmdProc1, + (void *)"original", + CmdDelProc1); + break; + case CMDINFO_DELETE: Tcl_DStringInit(&delString); - Tcl_DeleteCommand(interp, argv[2]); + Tcl_DeleteCommand(interp, Tcl_GetString(objv[2])); Tcl_DStringResult(interp, &delString); - } else if (strcmp(argv[1], "get") == 0) { - if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) { + break; + case CMDINFO_GET: + if (Tcl_GetCommandInfo(interp, Tcl_GetString(objv[2]), &info) ==0) { Tcl_AppendResult(interp, "??", NULL); return TCL_OK; } @@ -1121,28 +1199,35 @@ TestcmdinfoCmd( Tcl_AppendResult(interp, " unknown", NULL); } Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, NULL); - if (info.isNativeObjectProc) { + if (info.isNativeObjectProc == 0) { + Tcl_AppendResult(interp, " stringProc", NULL); + } else if (info.isNativeObjectProc == 1) { Tcl_AppendResult(interp, " nativeObjectProc", NULL); + } else if (info.isNativeObjectProc == 2) { + Tcl_AppendResult(interp, " nativeObjectProc2", NULL); } else { - Tcl_AppendResult(interp, " stringProc", NULL); + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("Invalid isNativeObjectProc value %d", + info.isNativeObjectProc)); + return TCL_ERROR; } - } else if (strcmp(argv[1], "modify") == 0) { + break; + case CMDINFO_MODIFY: info.proc = CmdProc2; info.clientData = (void *) "new_command_data"; info.objProc = NULL; info.objClientData = NULL; info.deleteProc = CmdDelProc2; info.deleteData = (void *) "new_delete_data"; - if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) { + if (Tcl_SetCommandInfo(interp, Tcl_GetString(objv[2]), &info) == 0) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); } else { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1)); } - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create, delete, get, or modify", NULL); - return TCL_ERROR; + break; } + return TCL_OK; } @@ -5677,7 +5762,14 @@ TestbytestringObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - Tcl_Size n = 0; + struct { +#if !defined(TCL_NO_DEPRECATED) + int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */ +#else + Tcl_Size n; +#endif + int m; /* This variable should not be overwritten */ + } x = {0, 1}; const char *p; if (objc != 2) { @@ -5685,11 +5777,15 @@ TestbytestringObjCmd( return TCL_ERROR; } - p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &n); + p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &x.n); if (p == NULL) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n)); + if (x.m != 1) { + Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", NULL); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, x.n)); return TCL_OK; } @@ -6765,7 +6861,7 @@ TestWrongNumArgsObjCmd( Tcl_Size i, length; const char *msg; - if (objc + 1 < 4) { + if (objc < 3) { goto insufArgs; } diff --git a/generic/tclUtf.c b/generic/tclUtf.c index cc5769f..68112c5 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -348,6 +348,16 @@ Tcl_UniCharToUtfDString( p = string; wEnd = uniStr + uniLength; + +#if TCL_UTF_MAX < 4 + /* Initialize the buffer so that some random data doesn't trick + * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs. + * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its + * prior non-stateful nature, this call to memset can also be removed. + */ + memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength); +#endif + for (w = uniStr; w < wEnd; ) { p += Tcl_UniCharToUtf(*w, p); w++; @@ -391,6 +401,16 @@ Tcl_Char16ToUtfDString( p = string; wEnd = uniStr + uniLength; + +#if TCL_UTF_MAX < 4 + /* Initialize the buffer so that some random data doesn't trick + * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs. + * Because TCL_COMBINE is used here, memset() is required even when + * TCL_UTF_MAX == 4. + */ + memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength); +#endif + for (w = uniStr; w < wEnd; ) { if (!len && ((*w & 0xFC00) != 0xDC00)) { /* Special case for handling high surrogates. */ diff --git a/generic/tclUtil.c b/generic/tclUtil.c index b765a0f..07b497b 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3977,6 +3977,46 @@ TclIndexInvalidError ( } /* + *------------------------------------------------------------------------ + * + * TclCommandWordLimitErrpr -- + * + * Generates an error message limit on number of command words exceeded. + * + * Results: + * Always return TCL_ERROR. + * + * Side effects: + * If interp is not-NULL, an error message is stored in it. + * + *------------------------------------------------------------------------ + */ +int +TclCommandWordLimitError ( + Tcl_Interp *interp, /* May be NULL */ + Tcl_Size count) /* If <= 0, "unknown" */ +{ + if (interp) { + if (count > 0) { + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("Number of words (%" TCL_SIZE_MODIFIER + "d) in command exceeds limit %" TCL_SIZE_MODIFIER + "d.", + count, + (Tcl_Size)INT_MAX)); + } + else { + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("Number of words in command exceeds " + "limit %" TCL_SIZE_MODIFIER "d.", + (Tcl_Size)INT_MAX)); + } + } + return TCL_ERROR; /* Always */ +} + +/* *---------------------------------------------------------------------- * * ClearHash -- diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 1399ec9..e083243 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -3761,7 +3761,7 @@ ZlibStackChannelTransform( if (compDictObj != NULL) { cd->compDictObj = Tcl_DuplicateObj(compDictObj); Tcl_IncrRefCount(cd->compDictObj); - Tcl_GetByteArrayFromObj(cd->compDictObj, (size_t *)NULL); + Tcl_GetByteArrayFromObj(cd->compDictObj, (Tcl_Size *)NULL); } if (format == TCL_ZLIB_FORMAT_RAW) { diff --git a/macosx/README b/macosx/README index ee1b7ea..7261a01 100644 --- a/macosx/README +++ b/macosx/README @@ -129,8 +129,6 @@ Detailed Instructions for building with macosx/GNUmakefile (where ${ver} is a shell variable containing the Tcl version number e.g. '9.0'). Setup this shell variable as follows: ver="9.0" -If you are building from CVS, omit this step (CVS source tree names usually do -not contain a version number). - Setup environment variables as desired, e.g. for a universal build on 10.5: CFLAGS="-arch x86_64 -arch arm64 -mmacosx-version-min=10.5" diff --git a/tests/bigdata.test b/tests/bigdata.test index c580fbd..08556dd 100644 --- a/tests/bigdata.test +++ b/tests/bigdata.test @@ -116,6 +116,30 @@ set ::bigLengths(patlenmultiple) [bigPatlenMultiple $::bigLengths(intmax)] set ::bigLengths(upatlenmultiple) [bigPatlenMultiple $::bigLengths(uintmax)] # +# script limits +bigtestRO script-length-bigdata-1 {Test script length limit} b -body { + try [string cat [string repeat " " 0x7ffffff7] "set a b"] +} +# TODO - different behaviour between compiled and uncompiled +test script-length-bigdata-2.compiled {Test script length limit} -body { + try [string cat [string repeat " " 0x7ffffff8] "set a b"] +} -constraints { + bigdata +} -result {Script length 2147483647 exceeds max permitted length 2147483646.} -returnCodes error +test script-length-bigdata-2.uncompiled {Test script length limit} -body { + testevalex [string cat [string repeat " " 0x7ffffff8] "set a b"] +} -constraints { + bigdata + } -result b +test script-bytecode-length-bigdata-1 {Test bytecode length limit} -body { + # Note we need to exceed bytecode limit without exceeding script char limit + set s [string repeat {{*}$x;} [expr 0x7fffffff/6]] + catch $s r e +} -cleanup { + bigClean +} -constraints panic-in-EnterCmdStartData + +# # string cat bigtest string-cat-bigdata-1 "string cat large small result > INT_MAX" 1 -body { string equal \ @@ -139,9 +163,8 @@ bigtest string-cat-bigdata-3 "string cat result > UINT_MAX" 1 -body { bigtestRO string-equal/compare-bigdata-1 "string compare/equal equal strings" {0 1} -body { list [string compare $s1 $s2] [string equal $s1 $s2] } -setup { - set len [expr {$::bigLengths(intmax)+1}] - set s1 [bigString $len] - set s2 [bigString $len]; # Use separate string to avoid Tcl_Obj * being same + set s1 [bigString 0x100000000] + set s2 [bigString 0x100000000]; # Separate so Tcl_Obj is not the same } -cleanup { bigClean } @@ -152,15 +175,14 @@ bigtestRO string-equal/compare-bigdata-2 "string compare/equal -length unequal s lappend result [string equal $s1 $s2] # Check lengths > UINT_MAX # Also that lengths do not truncate to sizeof(int) - lappend result [string compare -length $len $s1 $s2] - lappend result [string equal -length $len $s1 $s2] + lappend result [string compare -length 0x100000000 $s1 $s2] + lappend result [string equal -length 0x100000000 $s1 $s2] } -setup { - set len [expr {$::bigLengths(uintmax)+2}] - set s1 [bigString $len] - set s2 [bigString $len $len]; # Differs in last char + set s1 [bigString 0x100000001] + set s2 [bigString 0x100000001 0x100000000]; # Differs in last char } -cleanup { bigClean -} -constraints bug-a814ee5bbd +} # # string first @@ -174,7 +196,7 @@ bigtestRO string-first-bigdata-1 "string first > INT_MAX" {2147483648 -1 2147483 set s [bigString 0x8000000a 0x80000000] } -cleanup { bigClean -} -constraints bug-a814ee5bbd +} bigtestRO string-first-bigdata-2 "string first > UINT_MAX" {4294967296 -1 4294967300 1} -body { list \ @@ -186,7 +208,7 @@ bigtestRO string-first-bigdata-2 "string first > UINT_MAX" {4294967296 -1 429496 set s [bigString 0x10000000a 0x100000000] } -cleanup { bigClean -} -constraints bug-a814ee5bbd +} bigtestRO string-first-bigdata-3 "string first - long needle" 10 -body { string first $needle $s @@ -195,7 +217,7 @@ bigtestRO string-first-bigdata-3 "string first - long needle" 10 -body { set needle [bigString 0x100000000] } -cleanup { bigClean needle -} -constraints bug-a814ee5bbd +} # # string index @@ -252,8 +274,7 @@ bigtestRO string-last-bigdata-1 "string last > INT_MAX" {2 -1 2147483640 11} -bo set s [bigString 0x80000010 2] } -cleanup { bigClean -} -constraints bug-a814ee5bbd - +} bigtestRO string-last-bigdata-2 "string last > UINT_MAX" {4294967300 -1 4294967290 1} -body { list \ [string last 0 $s] \ @@ -264,8 +285,7 @@ bigtestRO string-last-bigdata-2 "string last > UINT_MAX" {4294967300 -1 42949672 set s [bigString 0x10000000a 2] } -cleanup { bigClean -} -constraints bug-a814ee5bbd - +} bigtestRO string-last-bigdata-3 "string last - long needle" 0 -body { string last $needle $s } -setup { @@ -273,7 +293,7 @@ bigtestRO string-last-bigdata-3 "string last - long needle" 0 -body { set needle [bigString 0x100000000] } -cleanup { bigClean needle -} -constraints bug-a814ee5bbd +} # # string length @@ -331,8 +351,18 @@ bigtestRO string-range-bigdata-1 "string range" {6 7 5 {} 5 4 {} 9 {}} -body { set s [bigString 0x10000000a] } -cleanup { bigClean -} -constraints bug-ad9361fd20f0 -# TODO - once above bug is fixed, add tests for large result range +} +bigtestRO string-range-bigdata-2 "bug ad9361fd20 case 1" aXaaaa -body { + string range [string insert [string repeat a 0x80000000] end-0x7fffffff X] 0 5 +} +bigtestRO string-range-bigdata-3 "bug ad9361fd20 case 2" 2 -body { + string length [string range $s end-0x7fffffff end-0x7ffffffe] +} -setup { + set s [string repeat a 0xffffffff] +} -cleanup { + bigClean +} +# TODO - add tests for large result range # # string repeat - use bigtest, not bigtestRO !! @@ -363,8 +393,8 @@ bigtestRO string-replace-bigdata-1 "string replace" {789012345 012345678 XYZ7890 set s [bigString 0x10000000a] } -cleanup { bigClean -} -constraints bug-ad9361fd20f0 -# TODO - once above bug is fixed, add tests for large result range: +} +# TODO - # - replacements string is large # - replace in the middle - string length grows, shrinks # - last < first @@ -550,7 +580,7 @@ bigtestRO format-bigdata-1 "format %s" 1 -body { set s [bigString 0x100000000] } -cleanup { bigClean -} -constraints bug-a550f9710b +} bigtest format-bigdata-2 "format bigstring%s" 1 -body { set s [format $s X] string equal $s [bigString 0x100000001 0x100000000] @@ -559,24 +589,71 @@ bigtest format-bigdata-2 "format bigstring%s" 1 -body { append s %s } -cleanup { bigClean -} -constraints bug-a550f9710b -# TODO - once above bugs fixed, add tests for width and precision +} +bigtest format-bigdata-3 "format big width" {4294967300 { } { a}} -body { + set s [format %4294967300s a] + list [string length $s] [string range $s 0 3] [string range $s end-3 end] +} -cleanup { + bigClean +} +bigtest format-bigdata-4 "format big negative width" {4294967300 {a } { }} -body { + set s [format %-4294967300s a] + list [string length $s] [string range $s 0 3] [string range $s end-3 end] +} -cleanup { + bigClean +} +bigtest format-bigdata-5 "format big * width" {4294967300 { } { a}} -body { + set s [format %*s 4294967300 a] + list [string length $s] [string range $s 0 3] [string range $s end-3 end] +} -cleanup { + bigClean +} +bigtest format-bigdata-6 "format big negative * width" {4294967300 {a } { }} -body { + set s [format %*s -4294967300 a] + list [string length $s] [string range $s 0 3] [string range $s end-3 end] +} -cleanup { + bigClean +} +bigtestRO format-bigdata-7 "format big precision" {4294967300 0123 6789} -body { + # Unset explicitly before setting to save memory as bigtestRO runs the + # script below twice. + unset -nocomplain s2 + set s2 [format %.4294967300s $s] + list [string length $s2] [string range $s2 0 3] [string range $s2 end-3 end] +} -setup { + set s [testbigdata string 4294967310] +} -cleanup { + bigClean +} +bigtestRO format-bigdata-8 "format big * precision" {4294967300 0123 6789} -body { + # Unset explicitly before setting to save memory as bigtestRO runs the + # script below twice. + unset -nocomplain s2 + set s2 [format %.*s 4294967300 $s] + list [string length $s2] [string range $s2 0 3] [string range $s2 end-3 end] +} -setup { + set s [testbigdata string 4294967310] +} -cleanup { + bigClean +} # # scan -bigtestRO scan-bigdata-1 "scan %s" {1 1 2 1} -body { +bigtestRO scan-bigdata-1 "scan %s" {1 1 2 X 1 2 4294967300 01234X} -body { # Unset explicitly before setting to save memory as bigtestRO runs the # script below twice. - unset -nocomplain result digits + unset -nocomplain result digits x lappend result [string equal [scan $s %s] $s] lappend result [string equal [scan $s {%[0-9X]}] $s] lappend result [scan $s {%[0-9]%s} digits x] $x - lappend result [string equal $digits [bigString 0x100000008]] + lappend result [string equal $digits [bigString 0x100000009]] + lappend result [scan $s %4294967300s%s x y] + lappend result [string length $x] $y } -setup { set s [bigString 0x10000000a 0x100000009] } -cleanup { bigClean digits -} -constraints bug-d4ede611a7 +} # # regexp @@ -635,16 +712,16 @@ bigtestRO subst-bigdata-1 "subst" {1 1} -body { # # binary format -bigtestRO binary-format-bigdata-1 "binary format aN" 4294967296 -body { +bigtestRO binary-format-bigdata-1 "binary format aN" [list 4294967296 X\0\0\0 \0\0\0\0] -body { # Unset explicitly before setting to save memory as bigtestRO runs the # script below twice. unset -nocomplain bin set bin [binary format a4294967296 X] - string length $bin + list [string length $bin] [string range $bin 0 3] [string range $bin end-3 end] } -cleanup { bigClean -} -constraints bug-9369f83649 -# TODO - do string compare and add other format specifiers once above bug is fixed +} +# TODO - do string compare and add other format specifiers bigtestRO binary-format-bigdata-2 "binary format a*" 1 -body { # Unset explicitly before setting to save memory as bigtestRO runs the @@ -660,17 +737,17 @@ bigtestRO binary-format-bigdata-2 "binary format a*" 1 -body { # # binary scan -bigtestRO binary-scan-bigdata-1 "binary scan aN" 4294967296 -body { +bigtestRO binary-scan-bigdata-1 "binary scan aN" {4294967296 0123 2345} -body { # Unset explicitly before setting to save memory as bigtestRO runs the # script below twice. unset -nocomplain bin2 binary scan $bin a4294967296 bin2 - string length $bin2 + list [string length $bin2] [string range $bin2 0 3] [string range $bin2 end-3 end] } -setup { set bin [bigBinary 4294967296] } -cleanup { bigClean -} -constraints bug-9369f83649 +} # TODO - do string compare and add other format specifiers once above bug is fixed bigtestRO binary-scan-bigdata-2 "binary scan a*" 1 -body { @@ -696,7 +773,7 @@ bigtestRO binary-encode/decode-base64-bigdata-1 "binary encode/decode base64" 1 set bin [bigBinary 4294967296] } -cleanup { bigClean -} -constraints bug-c719fa8716 +} # # binary encode / decode hex @@ -718,7 +795,7 @@ bigtestRO binary-encode/decode-uuencode-bigdata-1 "binary encode/decode uuencode set bin [bigBinary 4294967296] } -cleanup { bigClean -} -constraints bug-2e3fed53ba +} ################################################################ # List commands @@ -782,14 +859,15 @@ bigtest ledit-bigdata-2 "ledit - large result" {4294967304 4294967304 {a b c d e bigClean } -bigtest ledit-bigdata-3 "ledit - small -> large result" {2147483651 2147483651} -body { - set l2 {a b c x y z} - list [llength [ledit l2 2 3 {*}$l]] [llength $l2] +bigtest ledit-bigdata-3 "ledit - small -> large result" {2147483650 2147483650 {a b 0 1 2 3 4 5} {0 1 e f g h i j}} -body { + set l2 {a b c d e f g h i j} + list [llength [ledit l2 2 3 {*}$l]] [llength $l2] [lrange $l2 0 7] [lrange $l2 end-7 end] } -setup { - set l [bigList 2147483647] + # Note total number of arguments has to be less than INT_MAX + set l [bigList 2147483642] } -cleanup { bigClean -} -constraints bug-7cddd2845c +} -constraints memory-allocation-panic # # lindex @@ -808,8 +886,8 @@ bigtestRO lindex-bigdata-1 "lindex" {6 7 5 {} 5 4 {} 9 {}} -body { set l [bigList 0x10000000a] } -cleanup { bigClean -} -constraints bug-dcac54a685 -# TODO after bug fix - nested index +} +# TODO nested index # # linsert @@ -831,15 +909,25 @@ bigtest linsert-bigdata-1 "linsert" {4294967330 1} -body { # # list and {*} -bigtestRO list-bigdata-1 {list {*} } {4294967296 0 4294967295} -body { - unset -nocomplain l2 +# TODO - compiled and uncompiled behave differently so tested separately +test list-bigdata-1.compiled {list {*}} -body { + set l [bigList 0x100000000] set l2 [list {*}$l] + unset l list [llength $l2] [lindex $l2 0] [lindex $l2 end] -} -setup { - set l [bigList 0x100000000] } -cleanup { bigClean -} -constraints bug-7cddd2845c +} -constraints { + bigdata +} -result {4294967296 0 5} +test list-bigdata-1.uncompiled {list {*}} -body { + set l [bigList 0x7fffffff] + testevalex {set l2 [list {*}$l]} +} -cleanup { + bigClean +} -constraints { + bigdata +} -result {Number of words in command exceeds limit 2147483647.} -returnCodes error # # llength @@ -871,9 +959,10 @@ bigtestRO lmap-bigdata-1 "lmap" 4294967296 -body { # # lrange -bigtestRO lrange-bigdata-1 "lrange" {6 7 5 {} 5 4 {} 9 {}} -body { +bigtestRO lrange-bigdata-1 "lrange" {6 {6 7} 7 5 {} 5 4 {} 9 {8 9} {}} -body { list \ [lrange $l 0x100000000 0x100000000] \ + [lrange $l 0x100000000 0x100000001] \ [lrange $l 0x100000000+1 0x100000000+1] \ [lrange $l 0x100000000-1 0x100000000-1] \ [lrange $l 0x10000000a 0x10000000a] \ @@ -881,13 +970,14 @@ bigtestRO lrange-bigdata-1 "lrange" {6 7 5 {} 5 4 {} 9 {}} -body { [lrange $l end-1 end-1] \ [lrange $l end+1 end+1] \ [lrange $l end-0x100000000 end-0x100000000] \ + [lrange $l end-0x100000001 end-0x100000000] \ [lrange $l end-0x10000000a end-0x10000000a] } -setup { set l [bigList 0x10000000a] } -cleanup { bigClean -} -constraints bug-dcac54a685 -# TODO - once above bug is fixed, add tests for large result range +} +# TODO - add tests for large result range # # lrepeat - use bigtest, not bigtestRO !! @@ -1021,6 +1111,42 @@ bigtestRO concat-bigdata-1 "concat" {4294967296 {0 1 2 3 4} {6 7 0 1 2} {3 4 5 6 set l [bigList 0x80000000] } +test puts-bigdata-1 "puts" -setup { + set fpath [makeFile {} bug-0306a5563.data] +} -constraints { + bug0306a5563 + bigdata +} -body { + set fd [open $fpath w] + puts -nonewline $fd [testbigdata string 0x80000001] + close $fd + set fd [open $fpath] + seek $fd 0x7FFFFFFA + set written [read $fd] + close $fd + set written +} -result {2345678} + +test puts-bigdata-2 "puts" -setup { + set fpath [tcltest::makeFile {} bug-0306a5563.data] +} -constraints { + bug0306a5563 + bigdata +} -body { + set fd [open $fpath w] + set s [testbigdata string 0x7FFFFFFE] + # The character to append in the next line is —, EM DASH, + # code point 0x2014 (decimal 8212, UTF-8 #xE2 #x80 #x94) + append s \u2014 + puts -nonewline $fd $s + close $fd + set fd [open $fpath] + seek $fd 0x7FFFFFFA + set written [read $fd] + close $fd + set written +} -result {2345—} + # # TODO # lremove diff --git a/tests/binary.test b/tests/binary.test index a947410..be8dd10 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -15,11 +15,14 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands +source [file join [file dirname [info script]] tcltests.tcl] + catch [list package require -exact tcl::test [info patchlevel]] testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}] testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}] testConstraint testbytestring [llength [info commands testbytestring]] +testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] # Big test for correct ordering of data in [expr] proc testIEEE {} { @@ -3039,6 +3042,9 @@ test binary-80.3 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes test binary-80.4 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xF0\x9F\x98\x81"] } -result "expected byte sequence but character 4 was '\U01F601' (U+01F601)" +test binary-80.5 {Tcl_GetBytesFromObj} -constraints testbytestring -constraints {pointerIs64bit deprecated} -body { + testbytestring [string repeat A [expr 2**31]] +} -returnCodes 1 -result "byte sequence length exceeds INT_MAX" # ---------------------------------------------------------------------- # cleanup diff --git a/tests/io.test b/tests/io.test index f5c18b5..713cf30 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9509,7 +9509,7 @@ test io-75.14 { lappend res [gets $chan] set status [catch {gets $chan} cres copts] lappend res $status $cres - chan configure $chan -profile tcl8 + chan configure $chan -profile tcl8 lappend res [gets $chan] lappend res [gets $chan] close $chan diff --git a/tests/lseq.test b/tests/lseq.test index 1dff72d..6bf89eb 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -19,7 +19,7 @@ testConstraint arithSeriesShimmer 1 testConstraint arithSeriesShimmerOk 1 testConstraint has64BitLengths [expr {$tcl_platform(pointerSize) == 8}] -## Arg errors +# Arg errors test lseq-1.1 {error cases} -body { lseq } \ @@ -416,9 +416,9 @@ test lseq-3.30 {lreverse with double values} arithSeriesDouble { arithseries 18.5 17.0 15.5 14.0 12.5 11.0 9.5 8.0 6.5 5.0 3.5} -test lseq-3.31 {lreverse inplace with doubles} arithSeriesDouble { +test lseq-3.31 {lreverse inplace with doubles} {arithSeriesDouble has64BitLengths} { lreverse [lseq 1.1 29.9 0.3] -} {29.9 29.599999999999998 29.299999999999997 29.0 28.7 28.4 28.099999999999998 27.799999999999997 27.5 27.2 26.9 26.599999999999998 26.299999999999997 26.0 25.7 25.4 25.099999999999998 24.799999999999997 24.5 24.2 23.9 23.599999999999998 23.299999999999997 23.0 22.7 22.4 22.099999999999998 21.799999999999997 21.5 21.2 20.9 20.6 20.299999999999997 20.0 19.7 19.4 19.1 18.799999999999997 18.5 18.2 17.9 17.6 17.299999999999997 17.0 16.7 16.4 16.1 15.799999999999999 15.5 15.2 14.899999999999999 14.6 14.299999999999999 14.0 13.7 13.399999999999999 13.099999999999998 12.8 12.5 12.2 11.899999999999999 11.599999999999998 11.3 11.0 10.7 10.399999999999999 10.099999999999998 9.8 9.5 9.2 8.899999999999999 8.599999999999998 8.3 8.0 7.699999999999999 7.399999999999999 7.099999999999998 6.800000000000001 6.5 6.199999999999999 5.899999999999999 5.599999999999998 5.300000000000001 5.0 4.699999999999999 4.399999999999999 4.099999999999998 3.8000000000000007 3.5 3.1999999999999993 2.8999999999999986 2.599999999999998 2.3000000000000007 2.0 1.6999999999999993 1.3999999999999986 1.1000000000000014} +} {29.9 29.6 29.3 29.0 28.7 28.4 28.1 27.8 27.5 27.2 26.9 26.6 26.3 26.0 25.7 25.4 25.1 24.8 24.5 24.2 23.9 23.6 23.3 23.0 22.7 22.4 22.1 21.8 21.5 21.2 20.9 20.6 20.3 20.0 19.7 19.4 19.1 18.8 18.5 18.2 17.9 17.6 17.3 17.0 16.7 16.4 16.1 15.8 15.5 15.2 14.9 14.6 14.3 14.0 13.7 13.4 13.1 12.8 12.5 12.2 11.9 11.6 11.3 11.0 10.7 10.4 10.1 9.8 9.5 9.2 8.9 8.6 8.3 8.0 7.7 7.4 7.1 6.8 6.5 6.2 5.9 5.6 5.3 5.0 4.7 4.4 4.1 3.8 3.5 3.2 2.9 2.6 2.3 2.0 1.7 1.4 1.1} test lseq-4.1 {end expressions} { set start 7 @@ -538,12 +538,12 @@ test lseq-4.8 {error case lrange} -body { } -returnCodes 1 \ -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?} -test lseq-4.9 {error case lrange} -body { - set fred 7 - set ginger 8 - lrange [lseq 1 5] $fred $ginger -} -returnCodes 1 \ - -result {index 7 is out of bounds 0 to 4} +test lseq-4.9 {lrange empty/partial sets} -body { + foreach {fred ginger} {7 8 4 9 0 15 9 9 4 2} { + lappend res [lrange [lseq 1 5] $fred $ginger] + } + set res +} -result {{} 5 {1 2 3 4 5} {} {}} # Panic when using variable value? test lseq-4.10 {panic using variable index} { @@ -551,6 +551,39 @@ test lseq-4.10 {panic using variable index} { lindex [lseq 10] $i } {0} +test lseq-4.11 {bug lseq / lindex discrepancies} -constraints has64BitLengths -body { + lindex [lseq 0x7fffffff] 0x80000000 +} -result {} + +test lseq-4.12 {bug lseq} -constraints has64BitLengths -body { + llength [lseq 0x100000000] +} -result {4294967296} + +test lseq-4.13 {bug lseq} -constraints has64BitLengths -body { + set l [lseq 0x7fffffffffffffff] + list \ + [llength $l] \ + [lindex $l end] \ + [lindex $l 9223372036854775800] +} -result {9223372036854775807 9223372036854775806 9223372036854775800} + + +test lseq-4.14 {bug lseq - inconsistent rounding} has64BitLengths { + # using a non-integer increment, [lseq] rounding seems to be not consistent: + lseq 4 40 0.1 +} {4.0 4.1 4.2 4.3 4.4 4.5 4.6 4.7 4.8 4.9 5.0 5.1 5.2 5.3 5.4 5.5 5.6 5.7 5.8 5.9 6.0 6.1 6.2 6.3 6.4 6.5 6.6 6.7 6.8 6.9 7.0 7.1 7.2 7.3 7.4 7.5 7.6 7.7 7.8 7.9 8.0 8.1 8.2 8.3 8.4 8.5 8.6 8.7 8.8 8.9 9.0 9.1 9.2 9.3 9.4 9.5 9.6 9.7 9.8 9.9 10.0 10.1 10.2 10.3 10.4 10.5 10.6 10.7 10.8 10.9 11.0 11.1 11.2 11.3 11.4 11.5 11.6 11.7 11.8 11.9 12.0 12.1 12.2 12.3 12.4 12.5 12.6 12.7 12.8 12.9 13.0 13.1 13.2 13.3 13.4 13.5 13.6 13.7 13.8 13.9 14.0 14.1 14.2 14.3 14.4 14.5 14.6 14.7 14.8 14.9 15.0 15.1 15.2 15.3 15.4 15.5 15.6 15.7 15.8 15.9 16.0 16.1 16.2 16.3 16.4 16.5 16.6 16.7 16.8 16.9 17.0 17.1 17.2 17.3 17.4 17.5 17.6 17.7 17.8 17.9 18.0 18.1 18.2 18.3 18.4 18.5 18.6 18.7 18.8 18.9 19.0 19.1 19.2 19.3 19.4 19.5 19.6 19.7 19.8 19.9 20.0 20.1 20.2 20.3 20.4 20.5 20.6 20.7 20.8 20.9 21.0 21.1 21.2 21.3 21.4 21.5 21.6 21.7 21.8 21.9 22.0 22.1 22.2 22.3 22.4 22.5 22.6 22.7 22.8 22.9 23.0 23.1 23.2 23.3 23.4 23.5 23.6 23.7 23.8 23.9 24.0 24.1 24.2 24.3 24.4 24.5 24.6 24.7 24.8 24.9 25.0 25.1 25.2 25.3 25.4 25.5 25.6 25.7 25.8 25.9 26.0 26.1 26.2 26.3 26.4 26.5 26.6 26.7 26.8 26.9 27.0 27.1 27.2 27.3 27.4 27.5 27.6 27.7 27.8 27.9 28.0 28.1 28.2 28.3 28.4 28.5 28.6 28.7 28.8 28.9 29.0 29.1 29.2 29.3 29.4 29.5 29.6 29.7 29.8 29.9 30.0 30.1 30.2 30.3 30.4 30.5 30.6 30.7 30.8 30.9 31.0 31.1 31.2 31.3 31.4 31.5 31.6 31.7 31.8 31.9 32.0 32.1 32.2 32.3 32.4 32.5 32.6 32.7 32.8 32.9 33.0 33.1 33.2 33.3 33.4 33.5 33.6 33.7 33.8 33.9 34.0 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 35.0 35.1 35.2 35.3 35.4 35.5 35.6 35.7 35.8 35.9 36.0 36.1 36.2 36.3 36.4 36.5 36.6 36.7 36.8 36.9 37.0 37.1 37.2 37.3 37.4 37.5 37.6 37.7 37.8 37.9 38.0 38.1 38.2 38.3 38.4 38.5 38.6 38.7 38.8 38.9 39.0 39.1 39.2 39.3 39.4 39.5 39.6 39.7 39.8 39.9 40.0} + +test lseq-4.15 {bug lseq - inconsistent rounding} has64BitLengths { + # using a non-integer increment, [lseq] rounding seems to be not consistent: + lseq 6 40 0.1 +} {6.0 6.1 6.2 6.3 6.4 6.5 6.6 6.7 6.8 6.9 7.0 7.1 7.2 7.3 7.4 7.5 7.6 7.7 7.8 7.9 8.0 8.1 8.2 8.3 8.4 8.5 8.6 8.7 8.8 8.9 9.0 9.1 9.2 9.3 9.4 9.5 9.6 9.7 9.8 9.9 10.0 10.1 10.2 10.3 10.4 10.5 10.6 10.7 10.8 10.9 11.0 11.1 11.2 11.3 11.4 11.5 11.6 11.7 11.8 11.9 12.0 12.1 12.2 12.3 12.4 12.5 12.6 12.7 12.8 12.9 13.0 13.1 13.2 13.3 13.4 13.5 13.6 13.7 13.8 13.9 14.0 14.1 14.2 14.3 14.4 14.5 14.6 14.7 14.8 14.9 15.0 15.1 15.2 15.3 15.4 15.5 15.6 15.7 15.8 15.9 16.0 16.1 16.2 16.3 16.4 16.5 16.6 16.7 16.8 16.9 17.0 17.1 17.2 17.3 17.4 17.5 17.6 17.7 17.8 17.9 18.0 18.1 18.2 18.3 18.4 18.5 18.6 18.7 18.8 18.9 19.0 19.1 19.2 19.3 19.4 19.5 19.6 19.7 19.8 19.9 20.0 20.1 20.2 20.3 20.4 20.5 20.6 20.7 20.8 20.9 21.0 21.1 21.2 21.3 21.4 21.5 21.6 21.7 21.8 21.9 22.0 22.1 22.2 22.3 22.4 22.5 22.6 22.7 22.8 22.9 23.0 23.1 23.2 23.3 23.4 23.5 23.6 23.7 23.8 23.9 24.0 24.1 24.2 24.3 24.4 24.5 24.6 24.7 24.8 24.9 25.0 25.1 25.2 25.3 25.4 25.5 25.6 25.7 25.8 25.9 26.0 26.1 26.2 26.3 26.4 26.5 26.6 26.7 26.8 26.9 27.0 27.1 27.2 27.3 27.4 27.5 27.6 27.7 27.8 27.9 28.0 28.1 28.2 28.3 28.4 28.5 28.6 28.7 28.8 28.9 29.0 29.1 29.2 29.3 29.4 29.5 29.6 29.7 29.8 29.9 30.0 30.1 30.2 30.3 30.4 30.5 30.6 30.7 30.8 30.9 31.0 31.1 31.2 31.3 31.4 31.5 31.6 31.7 31.8 31.9 32.0 32.1 32.2 32.3 32.4 32.5 32.6 32.7 32.8 32.9 33.0 33.1 33.2 33.3 33.4 33.5 33.6 33.7 33.8 33.9 34.0 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 35.0 35.1 35.2 35.3 35.4 35.5 35.6 35.7 35.8 35.9 36.0 36.1 36.2 36.3 36.4 36.5 36.6 36.7 36.8 36.9 37.0 37.1 37.2 37.3 37.4 37.5 37.6 37.7 37.8 37.9 38.0 38.1 38.2 38.3 38.4 38.5 38.6 38.7 38.8 38.9 39.0 39.1 39.2 39.3 39.4 39.5 39.6 39.7 39.8 39.9 40.0} + +test lseq-4.16 {bug lseq - inconsistent rounding} { + # using a non-integer increment, [lseq] rounding seems to be not consistent: + set res {} + lappend res [lseq 4.07 6 0.1] + lappend res [lseq 4.03 4.208 0.013] +} {{4.07 4.17 4.27 4.37 4.47 4.57 4.67 4.77 4.87 4.97 5.07 5.17 5.27 5.37 5.47 5.57 5.67 5.77 5.87 5.97} {4.03 4.043 4.056 4.069 4.082 4.095 4.108 4.121 4.134 4.147 4.16 4.173 4.186 4.199}} # cleanup ::tcltest::cleanupTests diff --git a/tests/scan.test b/tests/scan.test index cf58828..6d7a9fb 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -858,6 +858,12 @@ test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} { set msg [scan "10 20 30" {%100$d %5$d %200$d}] list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199] } {200 10 20 30} +test scan-13.9 {Tcl_ScanObjCmd, inline XPG case limit error} -body { + # Note this applies to 64-bit builds as well so long as max number of + # command line arguments allowed for scan command is INT_MAX + scan abc {%2147483648$s} +} -result {"%n$" argument index out of range} -returnCodes error + # scan infinities - not working diff --git a/tests/string.test b/tests/string.test index c8a4b2e..835acb9 100644 --- a/tests/string.test +++ b/tests/string.test @@ -2433,11 +2433,11 @@ test string-29.11.$noComp {string cat, efficiency} -body { test string-29.12.$noComp {string cat, efficiency} -body { tcl::unsupported::representation \ [run {string cat [encoding convertto utf-8 {}] [list x]}] -} -match glob -result {*, string representation "x"} +} -match glob -result {*, no string representation} test string-29.13.$noComp {string cat, efficiency} -body { tcl::unsupported::representation [run {string cat \ [encoding convertto utf-8 {}] [encoding convertto utf-8 {}] [list x]}] -} -match glob -result {*, string representation "x"} +} -match glob -result {*, no string representation} test string-29.14.$noComp {string cat, efficiency} -setup { set e [encoding convertto utf-8 {}] } -cleanup { diff --git a/tests/tailcall.test b/tests/tailcall.test index c738bb3..c9ec674 100644 --- a/tests/tailcall.test +++ b/tests/tailcall.test @@ -708,6 +708,13 @@ test tailcall-14.1-bc {{in a deleted namespace} {byte compiled}} -body { } } -returnCodes 1 -result {namespace "::ns" not found} +test tailcall-bug-784befb0ba {tailcall crash with 254 args} -body { + proc tccrash args {llength $args} + # Must be EXACTLY 254 for crash + proc p {} [list tailcall tccrash {*}[lrepeat 254 x]] + p +} -result 254 + # cleanup ::tcltest::cleanupTests diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 1aecbd8..9c84657 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -546,8 +546,8 @@ TclpInitLibraryPath( *encodingPtr = Tcl_GetEncoding(NULL, NULL); /* - * Note lengthPtr is (TCL_HASH_TYPE *) which is unsigned so cannot - * pass directly to Tcl_GetStringFromObj. + * Note lengthPtr is (TCL_HASH_TYPE *) which is unsigned so cannot + * pass directly to Tcl_GetStringFromObj. * TODO - why is the type TCL_HASH_TYPE anyways? */ Tcl_Size length; diff --git a/win/rules.vc b/win/rules.vc index d8b3b12..87b6fa5 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -887,12 +887,12 @@ TCL_BUILD_FOR = 8 !message *** Force 64-bit time_t
_USE_64BIT_TIME_T = 1
!endif
+!endif
!if [nmakehlp -f $(OPTS) "utf16"]
!message *** Force UTF-16 internally
TCL_UTF_MAX = 3
!endif
-!endif
# Yes, it's weird that the "symbols" option controls DEBUG and
# the "pdbs" option controls SYMBOLS. That's historical.
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 4b49b7a..eced17e 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -84,18 +84,11 @@ static int gInitialized = 0; * Ring buffer for storing data. Actual data is from bufPtr[start]:bufPtr[size-1] * and bufPtr[0]:bufPtr[length - (size-start)]. */ -#if TCL_MAJOR_VERSION > 8 -typedef ptrdiff_t RingSizeT; /* Tcl9 TODO */ -#define RingSizeT_MAX PTRDIFF_MAX -#else -typedef int RingSizeT; -#define RingSizeT_MAX INT_MAX -#endif typedef struct RingBuffer { char *bufPtr; /* Pointer to buffer storage */ - RingSizeT capacity; /* Size of the buffer in RingBufferChar */ - RingSizeT start; /* Start of the data within the buffer. */ - RingSizeT length; /* Number of RingBufferChar*/ + Tcl_Size capacity; /* Size of the buffer in RingBufferChar */ + Tcl_Size start; /* Start of the data within the buffer. */ + Tcl_Size length; /* Number of RingBufferChar*/ } RingBuffer; #define RingBufferLength(ringPtr_) ((ringPtr_)->length) #define RingBufferHasFreeSpace(ringPtr_) ((ringPtr_)->length < (ringPtr_)->capacity) @@ -234,16 +227,16 @@ static void ConsoleWatchProc(void *instanceData, int mask); static void ProcExitHandler(void *clientData); static void ConsoleThreadActionProc(void *instanceData, int action); static DWORD ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer, - RingSizeT nChars, RingSizeT *nCharsReadPtr); + Tcl_Size nChars, Tcl_Size *nCharsReadPtr); static DWORD WriteConsoleChars(HANDLE hConsole, - const WCHAR *lpBuffer, RingSizeT nChars, - RingSizeT *nCharsWritten); -static void RingBufferInit(RingBuffer *ringPtr, RingSizeT capacity); + const WCHAR *lpBuffer, Tcl_Size nChars, + Tcl_Size *nCharsWritten); +static void RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity); static void RingBufferClear(RingBuffer *ringPtr); -static RingSizeT RingBufferIn(RingBuffer *ringPtr, const char *srcPtr, - RingSizeT srcLen, int partialCopyOk); -static RingSizeT RingBufferOut(RingBuffer *ringPtr, char *dstPtr, - RingSizeT dstCapacity, int partialCopyOk); +static Tcl_Size RingBufferIn(RingBuffer *ringPtr, const char *srcPtr, + Tcl_Size srcLen, int partialCopyOk); +static Tcl_Size RingBufferOut(RingBuffer *ringPtr, char *dstPtr, + Tcl_Size dstCapacity, int partialCopyOk); static ConsoleHandleInfo *AllocateConsoleHandleInfo(HANDLE consoleHandle, int permissions); static ConsoleHandleInfo *FindConsoleInfo(const ConsoleChannelInfo *); @@ -331,9 +324,9 @@ static const Tcl_ChannelType consoleChannelType = { *------------------------------------------------------------------------ */ static void -RingBufferInit(RingBuffer *ringPtr, RingSizeT capacity) +RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity) { - if (capacity <= 0 || capacity > RingSizeT_MAX) { + if (capacity <= 0 || capacity > TCL_SIZE_MAX) { Tcl_Panic("Internal error: invalid ring buffer capacity requested."); } ringPtr->bufPtr = (char *)Tcl_Alloc(capacity); @@ -384,15 +377,15 @@ RingBufferClear(RingBuffer *ringPtr) * *------------------------------------------------------------------------ */ -static RingSizeT +static Tcl_Size RingBufferIn( RingBuffer *ringPtr, const char *srcPtr, /* Source to be copied */ - RingSizeT srcLen, /* Length of source */ + Tcl_Size srcLen, /* Length of source */ int partialCopyOk /* If true, partial copy is permitted */ ) { - RingSizeT freeSpace; + Tcl_Size freeSpace; RINGBUFFER_ASSERT(ringPtr); @@ -407,8 +400,8 @@ RingBufferIn( if (ringPtr->capacity - ringPtr->start > ringPtr->length) { /* There is room at the back */ - RingSizeT endSpaceStart = ringPtr->start + ringPtr->length; - RingSizeT endSpace = ringPtr->capacity - endSpaceStart; + Tcl_Size endSpaceStart = ringPtr->start + ringPtr->length; + Tcl_Size endSpace = ringPtr->capacity - endSpaceStart; if (endSpace >= srcLen) { /* Everything fits at the back */ memmove(endSpaceStart + ringPtr->bufPtr, srcPtr, srcLen); @@ -419,7 +412,7 @@ RingBufferIn( } } else { /* No room at the back. Existing data wrap to front. */ - RingSizeT wrapLen = + Tcl_Size wrapLen = ringPtr->start + ringPtr->length - ringPtr->capacity; memmove(wrapLen + ringPtr->bufPtr, srcPtr, srcLen); } @@ -447,13 +440,13 @@ RingBufferIn( * *------------------------------------------------------------------------ */ -static RingSizeT +static Tcl_Size RingBufferOut(RingBuffer *ringPtr, char *dstPtr, /* Buffer for output data. May be NULL */ - RingSizeT dstCapacity, /* Size of buffer */ + Tcl_Size dstCapacity, /* Size of buffer */ int partialCopyOk) /* If true, return what's available */ { - RingSizeT leadLen; + Tcl_Size leadLen; RINGBUFFER_ASSERT(ringPtr); @@ -477,7 +470,7 @@ RingBufferOut(RingBuffer *ringPtr, } ringPtr->start += dstCapacity; } else { - RingSizeT wrapLen = dstCapacity - leadLen; + Tcl_Size wrapLen = dstCapacity - leadLen; if (dstPtr) { memmove(dstPtr, ringPtr->start + ringPtr->bufPtr, @@ -529,8 +522,8 @@ static DWORD ReadConsoleChars( HANDLE hConsole, WCHAR *lpBuffer, - RingSizeT nChars, - RingSizeT *nCharsReadPtr) + Tcl_Size nChars, + Tcl_Size *nCharsReadPtr) { DWORD nRead; BOOL result; @@ -589,8 +582,8 @@ static DWORD WriteConsoleChars( HANDLE hConsole, const WCHAR *lpBuffer, - RingSizeT nChars, - RingSizeT *nCharsWrittenPtr) + Tcl_Size nChars, + Tcl_Size *nCharsWrittenPtr) { DWORD nCharsWritten; BOOL result; @@ -1090,7 +1083,7 @@ ConsoleInputProc( { ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; ConsoleHandleInfo *handleInfoPtr; - RingSizeT numRead; + Tcl_Size numRead; if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) { return 0; /* EOF */ @@ -1160,7 +1153,7 @@ ConsoleInputProc( && bufSize > 1 /* Not single byte read */ ) { DWORD lastError; - RingSizeT numChars; + Tcl_Size numChars; ReleaseSRWLockExclusive(&handleInfoPtr->lock); lastError = ReadConsoleChars(chanInfoPtr->handle, (WCHAR *)bufPtr, @@ -1242,7 +1235,7 @@ ConsoleOutputProc( { ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; ConsoleHandleInfo *handleInfoPtr; - RingSizeT numWritten; + Tcl_Size numWritten; *errorCode = 0; @@ -1638,8 +1631,8 @@ ConsoleReaderThread( ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg; ConsoleHandleInfo **iterator; char inputChars[200]; /* Temporary buffer */ - RingSizeT inputLen = 0; - RingSizeT inputOffset = 0; + Tcl_Size inputLen = 0; + Tcl_Size inputOffset = 0; /* * Keep looping until one of the following happens. @@ -1670,7 +1663,7 @@ ConsoleReaderThread( HANDLE consoleHandle; if (inputLen > 0) { /* Private buffer has data. Copy it over. */ - RingSizeT nStored; + Tcl_Size nStored; assert((inputLen - inputOffset) > 0); @@ -1833,7 +1826,7 @@ ConsoleWriterThread(LPVOID arg) ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg; ConsoleHandleInfo **iterator; BOOL success; - RingSizeT numBytes; + Tcl_Size numBytes; /* * This buffer size has no relation really with the size of the shared * buffer. Could be bigger or smaller. Make larger as multiple threads @@ -1904,7 +1897,7 @@ ConsoleWriterThread(LPVOID arg) ReleaseSRWLockExclusive(&handleInfoPtr->lock); offset = 0; while (numBytes > 0) { - RingSizeT numWChars = numBytes / sizeof(WCHAR); + Tcl_Size numWChars = numBytes / sizeof(WCHAR); DWORD status; status = WriteConsoleChars(handleInfoPtr->console, (WCHAR *)(offset + buffer), diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 391c119..37f0834 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1536,7 +1536,7 @@ GetWinFileAttributes( * We test for, and fix that case, here. */ - size_t len; + Tcl_Size len; const char *str = Tcl_GetStringFromObj(fileName, &len); if (len < 4) { diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 0410356..bcd0920 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -921,7 +921,7 @@ TclpMatchInDirectory( DWORD attr; WIN32_FILE_ATTRIBUTE_DATA data; - size_t len = 0; + Tcl_Size len = 0; const char *str = Tcl_GetStringFromObj(norm, &len); native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr); @@ -943,7 +943,7 @@ TclpMatchInDirectory( WIN32_FIND_DATAW data; const char *dirName; /* UTF-8 dir name, later with pattern * appended. */ - size_t dirLength; + Tcl_Size dirLength; int matchSpecialDots; Tcl_DString ds; /* Native encoding of dir, also used * temporarily for other things. */ @@ -2796,7 +2796,7 @@ TclpObjNormalizePath( */ Tcl_Obj *tmpPathPtr; - size_t len; + Tcl_Size len; tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), nextCheckpoint); @@ -2885,7 +2885,7 @@ TclWinVolumeRelativeNormalize( * also on drive C. */ - size_t cwdLen; + Tcl_Size cwdLen; const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen); char drive_cur = path[0]; @@ -3022,7 +3022,7 @@ TclNativeCreateNativeRep( WCHAR *nativePathPtr = NULL; const char *str; Tcl_Obj *validPathPtr; - size_t len; + Tcl_Size len; WCHAR *wp; if (TclFSCwdIsNative()) { diff --git a/win/tclWinInit.c b/win/tclWinInit.c index ec27837..510b6df 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -131,7 +131,7 @@ TclpInitLibraryPath( Tcl_Obj *pathPtr; char installLib[LIBRARY_SIZE]; const char *bytes; - size_t length; + Tcl_Size length; TclNewObj(pathPtr); diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index da24306..d9cee73 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -3191,7 +3191,7 @@ TclpOpenTemporaryFile( char *namePtr; HANDLE handle; DWORD flags = FILE_ATTRIBUTE_TEMPORARY; - size_t length; + Tcl_Size length; int counter, counter2; Tcl_DString buf; |