diff options
52 files changed, 425 insertions, 301 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..3ced3c4 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -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/generic/tclArithSeries.c b/generic/tclArithSeries.c index 115f4b9..fd048a1 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -27,8 +27,8 @@ * - ArithSeriesGetInternalRep -- Return the internal rep from a Tcl_Obj * - Precision -- determine the number of factional digits for the given * double value - * - setPrecision -- Using the value in the given arithSeries, determine and - * set the percision in the arithSeries + * - maxPrecision -- Using the values provide, determine the longest percision + * in the arithSeries */ static inline double ArithRound(double d, unsigned int n) { @@ -81,16 +81,16 @@ Precision(double d) off = strchr(tmp, '.'); return (off ? strlen(off+1) : 0); } -static inline void -setPrecision(ArithSeriesDbl *arithSeriesRepPtr) +static inline int +maxPrecision(double start, double end, double step) { - // Find longest number of digits after the decimal point. - int dp = Precision(arithSeriesRepPtr->step); - int i = Precision(arithSeriesRepPtr->start); + // Find longest number of digits after the decimal point. + int dp = Precision(step); + int i = Precision(start); dp = i>dp ? i : dp; - i = Precision(arithSeriesRepPtr->end); + i = Precision(end); dp = i>dp ? i : dp; - arithSeriesRepPtr->precision = dp; + return dp; } /* @@ -215,7 +215,7 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide Tcl_Obj *arithSeriesObj; ArithSeries *arithSeriesRepPtr; - length = len>=0 ? len : (step == 0) ? 0 : ArithSeriesLenInt(start, end, step); + length = len>=0 ? len : -1; if (length < 0) length = -1; TclNewObj(arithSeriesObj); @@ -267,7 +267,7 @@ NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len) Tcl_Obj *arithSeriesObj; ArithSeriesDbl *arithSeriesRepPtr; - length = len>=0 ? len : ArithSeriesLenDbl(start, end, step); + length = len>=0 ? len : -1; if (length < 0) { length = -1; } @@ -285,7 +285,7 @@ NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len) arithSeriesRepPtr->step = step; arithSeriesRepPtr->len = length; arithSeriesRepPtr->elements = NULL; - setPrecision(arithSeriesRepPtr); + arithSeriesRepPtr->precision = maxPrecision(start,end,step); arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr; arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL; arithSeriesObj->typePtr = &tclArithSeriesType.objType; @@ -378,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); @@ -420,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); } } } @@ -905,9 +905,9 @@ TclArithSeriesObjRange( arithSeriesDblRepPtr->start = start; arithSeriesDblRepPtr->end = end; arithSeriesDblRepPtr->step = step; + arithSeriesDblRepPtr->precision = maxPrecision(start, end, step); arithSeriesDblRepPtr->len = ArithSeriesLenDbl(start, end, step); arithSeriesDblRepPtr->elements = NULL; - setPrecision(arithSeriesDblRepPtr); } else { Tcl_WideInt start, end, step; @@ -1096,7 +1096,6 @@ TclArithSeriesObjReverse( arithSeriesDblRepPtr->start = dstart; arithSeriesDblRepPtr->end = dend; arithSeriesDblRepPtr->step = dstep; - setPrecision(arithSeriesDblRepPtr); } else { arithSeriesRepPtr->start = start; arithSeriesRepPtr->end = end; diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index e3f9517..910532e 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -857,7 +857,7 @@ CompileAssembleObj( * names in the bytecode resolve */ int status; /* Status return from Tcl_AssembleCode */ const char* source; /* String representation of the source code */ - size_t sourceLen; /* Length of the source code in bytes */ + Tcl_Size sourceLen; /* Length of the source code in bytes */ /* * Get the expression ByteCode from the object. If it exists, make sure it diff --git a/generic/tclBinary.c b/generic/tclBinary.c index d0aa089..f8f006d 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -774,7 +774,7 @@ TclAppendBytesToByteArray( */ Tcl_Size attempt; - + /* Make sure we do not wrap when doubling */ if (needed <= (BYTEARRAY_MAX_LEN - needed)) { attempt = 2 * needed; @@ -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/tclCmdIL.c b/generic/tclCmdIL.c index 72d781c..7beb60a 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2326,6 +2326,7 @@ Tcl_LassignObjCmd( Tcl_Obj *listCopyPtr; Tcl_Obj **listObjv; /* The contents of the list. */ Tcl_Size listObjc; /* The length of the list. */ + Tcl_Size origListObjc; /* Original length */ int code = TCL_OK; if (objc < 2) { @@ -2337,8 +2338,10 @@ Tcl_LassignObjCmd( if (listCopyPtr == NULL) { return TCL_ERROR; } + Tcl_IncrRefCount(listCopyPtr); /* Important! fs */ TclListObjGetElementsM(NULL, listCopyPtr, &listObjc, &listObjv); + origListObjc = listObjc; objc -= 2; objv += 2; @@ -2366,7 +2369,13 @@ Tcl_LassignObjCmd( } if (code == TCL_OK && listObjc > 0) { - Tcl_SetObjResult(interp, Tcl_NewListObj(listObjc, listObjv)); + Tcl_Obj *resultObjPtr = TclListObjRange( + interp, listCopyPtr, origListObjc - listObjc, origListObjc - 1); + if (resultObjPtr == NULL) { + code = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, resultObjPtr); + } } Tcl_DecrRefCount(listCopyPtr); @@ -2759,7 +2768,11 @@ Tcl_LrangeObjCmd( return TCL_ERROR; } } else { - Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last)); + Tcl_Obj *resultObj = TclListObjRange(interp, objv[1], first, last); + if (resultObj == NULL) { + return TCL_ERROR; + } + Tcl_SetObjResult(interp, resultObj); } return TCL_OK; } @@ -2940,7 +2953,7 @@ Tcl_LrepeatObjCmd( } if (elementCount < 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad count \"%" TCL_Z_MODIFIER "d\": must be integer >= 0", elementCount)); + "bad count \"%" TCL_SIZE_MODIFIER "d\": must be integer >= 0", elementCount)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG", NULL); return TCL_ERROR; 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/tclCompCmds.c b/generic/tclCompCmds.c index 2c1fe69..f86de84 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -3156,7 +3156,7 @@ TclCompileFormatCmd( Tcl_Obj **objv, *formatObj, *tmpObj; const char *bytes, *start; int i, j; - size_t len; + Tcl_Size len; /* * Don't handle any guaranteed-error cases. diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 5b79187..f35cd50 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -2113,7 +2113,7 @@ TclCompileRegsubCmd( Tcl_DString pattern; const char *bytes; int exact, quantified, result = TCL_ERROR; - size_t len; + Tcl_Size len; if ((int)parsePtr->numWords < 5 || (int)parsePtr->numWords > 6) { return TCL_ERROR; @@ -2705,7 +2705,7 @@ IndexTailVarIfKnown( Tcl_Obj *tailPtr; const char *tailName, *p; int n = varTokenPtr->numComponents; - size_t len; + Tcl_Size len; Tcl_Token *lastTokenPtr; int full, localIndex; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index a819c97..531fbf0 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -252,7 +252,7 @@ TclCompileStringCatCmd( } else { Tcl_DecrRefCount(obj); if (folded) { - size_t len; + Tcl_Size len; const char *bytes = Tcl_GetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); @@ -270,7 +270,7 @@ TclCompileStringCatCmd( wordTokenPtr = TokenAfter(wordTokenPtr); } if (folded) { - size_t len; + Tcl_Size len; const char *bytes = Tcl_GetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 6940448..9448241 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -776,7 +776,7 @@ TclSetByteCodeFromAny( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - size_t length; + Tcl_Size length; int result = TCL_OK; const char *stringPtr; Proc *procPtr = iPtr->compiledProcPtr; @@ -1328,7 +1328,7 @@ CompileSubstObj( } if (codePtr == NULL) { CompileEnv compEnv; - size_t numBytes; + Tcl_Size numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); /* TODO: Check for more TIP 280 */ @@ -1812,7 +1812,7 @@ CompileCmdLiteral( const char *bytes; Command *cmdPtr; int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME; - size_t length; + Tcl_Size length; cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { @@ -2136,7 +2136,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 -1, the * script consists of all bytes up to the * first null character. */ CompileEnv *envPtr) /* Holds resulting instructions. */ @@ -2169,7 +2169,7 @@ TclCompileScript( /* Each iteration compiles one command from the script. */ - if (numBytes + 1 > 1) { + if (numBytes > 0) { /* * 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 89ff26c..bab0fd3 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4168,6 +4168,7 @@ extern const TclStubs *tclStubsPtr; # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) +#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)) \ @@ -4196,6 +4197,7 @@ extern const TclStubs *tclStubsPtr; # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \ ? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ : tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) +#endif /* TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) */ #else # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \ @@ -4243,42 +4245,6 @@ extern const TclStubs *tclStubsPtr; #define Tcl_GlobalEvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL) -#if defined(TCL_8_COMPAT) && !defined(BUILD_tcl) && TCL_MAJOR_VERSION > 8 -# ifdef USE_TCL_STUBS -# undef Tcl_Gets -# undef Tcl_GetsObj -# undef Tcl_Read -# undef Tcl_Ungets -# undef Tcl_Write -# undef Tcl_ReadChars -# undef Tcl_WriteChars -# undef Tcl_WriteObj -# undef Tcl_ReadRaw -# undef Tcl_WriteRaw -# define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_Gets)(chan, dsPtr)+1))-1) -# define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_GetsObj)(chan, objPtr)+1))-1) -# define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((tclStubsPtr->tcl_Read)(chan, bufPtr, toRead)+1))-1) -# define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((tclStubsPtr->tcl_Ungets)(chan, str, len, atHead)+1))-1) -# define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((tclStubsPtr->tcl_Write)(chan, s, slen)+1))-1) -# define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1) -# define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteChars)(chan, src, srcLen)+1))-1) -# define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteObj)(chan, objPtr)+1))-1) -# define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1) -# define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteRaw()(chan, src, srcLen)+1))-1) -# else -# define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((Tcl_Gets)(chan, dsPtr)+1))-1) -# define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((Tcl_GetsObj)(chan, objPtr)+1))-1) -# define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((Tcl_Read)(chan, bufPtr, toRead)+1))-1) -# define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((Tcl_Ungets)(chan, str, len, atHead)+1))-1) -# define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((Tcl_Write)(chan, s, slen)+1))-1) -# define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((Tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1) -# define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteChars)(chan, src, srcLen)+1))-1) -# define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((Tcl_WriteObj)(chan, objPtr)+1))-1) -# define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((Tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1) -# define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteRaw()(chan, src, srcLen)+1))-1) -# endif -#endif - #if TCL_MAJOR_VERSION > 8 # undef Tcl_Close # define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0) @@ -4293,4 +4259,10 @@ extern const TclStubs *tclStubsPtr; # define Tcl_GetMaster Tcl_GetParent #endif +/* TIP #660 for 8.7 */ +#if TCL_MAJOR_VERSION < 9 +# undef Tcl_GetSizeIntFromObj +# define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj +#endif + #endif /* _TCLDECLS */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index fca4ea5..2b8e8c0 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2786,9 +2786,9 @@ Utf32ToUtfProc( int prev = ch; #endif if (flags & TCL_ENCODING_LE) { - ch = (src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF); + ch = (unsigned int)(src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF); } else { - ch = (src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF); + ch = (unsigned int)(src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF); } #if TCL_UTF_MAX < 4 if (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f22538f..31a8695 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1437,7 +1437,7 @@ CompileExprObj( * TIP #280: No invoker (yet) - Expression compilation. */ - size_t length; + Tcl_Size length; const char *string = Tcl_GetStringFromObj(objPtr, &length); TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0); @@ -4945,12 +4945,12 @@ TEBCresume( if (TclHasInternalRep(valuePtr,&tclArithSeriesType.objType)) { objResultPtr = TclArithSeriesObjRange(interp, valuePtr, fromIdx, toIdx); - if (objResultPtr == NULL) { - TRACE_ERROR(interp); - goto gotError; - } } else { - objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx); + objResultPtr = TclListObjRange(interp, valuePtr, fromIdx, toIdx); + } + if (objResultPtr == NULL) { + TRACE_ERROR(interp); + goto gotError; } TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr))); diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index f5c9a37..ca4ff27 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -1381,7 +1381,7 @@ TclFileTemporaryCmd( TclNewObj(nameObj); } if (objc > 2) { - size_t length; + Tcl_Size length; Tcl_Obj *templateObj = objv[2]; const char *string = Tcl_GetStringFromObj(templateObj, &length); diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 4dab688..c9148c1 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -807,7 +807,7 @@ TclpNativeJoinPath( const char *joining) { int needsSep; - size_t length; + Tcl_Size length; char *dest; const char *p; const char *start; @@ -848,7 +848,7 @@ TclpNativeJoinPath( * Append the element, eliminating duplicate and trailing slashes. */ - Tcl_SetObjLength(prefix, length + (int) strlen(p)); + Tcl_SetObjLength(prefix, length + strlen(p)); dest = TclGetString(prefix) + length; for (; *p != '\0'; p++) { @@ -1358,7 +1358,7 @@ Tcl_GlobObjCmd( globTypes->macCreator = NULL; while (length-- > 0) { - size_t len; + Tcl_Size len; const char *str; Tcl_ListObjIndex(interp, typePtr, length, &look); @@ -2188,7 +2188,7 @@ DoGlob( */ if (*p == '\0') { - size_t length; + Tcl_Size length; Tcl_DString append; /* @@ -2252,7 +2252,7 @@ DoGlob( * The current prefix must end in a separator. */ - size_t len; + Tcl_Size len; const char *joined = Tcl_GetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { @@ -2289,7 +2289,7 @@ DoGlob( * This behaviour is not currently tested for in the test suite. */ - size_t len; + Tcl_Size len; const char *joined = Tcl_GetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index ecc8652..93c50ec 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -698,7 +698,7 @@ Tcl_CloseObjCmd( Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); const char *string; - size_t len; + Tcl_Size len; if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); @@ -858,7 +858,7 @@ Tcl_ExecObjCmd( const char *string; Tcl_Channel chan; int argc, background, i, index, keepNewline, result, skip, ignoreStderr; - size_t length; + Tcl_Size length; static const char *const options[] = { "-ignorestderr", "-keepnewline", "--", NULL }; diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index b3af45e..3c54366 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -2004,7 +2004,7 @@ InvokeTclMethod( */ if (result != TCL_ERROR) { Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv); - size_t cmdLen; + Tcl_Size cmdLen; const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); @@ -2770,7 +2770,7 @@ ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { - size_t len; + Tcl_Size len; const char *msgStr = Tcl_GetStringFromObj(obj, &len); len++; diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index f2f91a7..cec6ad3 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -521,7 +521,7 @@ TclFSCwdPointerEquals( if (tsdPtr->cwdPathPtr == *pathPtrPtr) { return 1; } else { - size_t len1, len2; + Tcl_Size len1, len2; const char *str1, *str2; str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); @@ -663,7 +663,7 @@ FsUpdateCwd( Tcl_Obj *cwdObj, void *clientData) { - size_t len = 0; + Tcl_Size len = 0; const char *str = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); @@ -1324,7 +1324,7 @@ TclFSNormalizeToUniquePath( { FilesystemRecord *fsRecPtr, *firstFsRecPtr; - size_t i; + Tcl_Size i; int isVfsPath = 0; const char *path; @@ -1686,7 +1686,7 @@ Tcl_FSEvalFileEx( const char *encodingName) /* Either the name of an encoding or NULL to use the utf-8 encoding. */ { - size_t length; + Tcl_Size length; int result = TCL_ERROR; Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile; @@ -1952,7 +1952,7 @@ EvalFileCallback( * Record information about where the error occurred. */ - size_t length; + Tcl_Size length; const char *pathString = Tcl_GetStringFromObj(pathPtr, &length); const unsigned int limit = 150; int overflow = (length > limit); @@ -2794,7 +2794,7 @@ Tcl_FSGetCwd( * infinite loop bug when trying to normalize tsdPtr->cwdPathPtr. */ - size_t len1, len2; + Tcl_Size len1, len2; const char *str1, *str2; str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); diff --git a/generic/tclInt.h b/generic/tclInt.h index d9c504e..a12d433 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3235,8 +3235,8 @@ MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); MODULE_SCOPE int TclListObjAppendElements(Tcl_Interp *interp, Tcl_Obj *toObj, Tcl_Size elemCount, Tcl_Obj *const elemObjv[]); -MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Obj *listPtr, Tcl_Size fromIdx, - Tcl_Size toIdx); +MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Interp *interp, Tcl_Obj *listPtr, + Tcl_Size fromIdx, Tcl_Size toIdx); MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *indexPtr, Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, @@ -3380,7 +3380,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, diff --git a/generic/tclLink.c b/generic/tclLink.c index 1cd5f15..7474769 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -592,7 +592,7 @@ SetInvalidRealFromAny( { const char *str; const char *endPtr; - size_t length; + Tcl_Size length; str = Tcl_GetStringFromObj(objPtr, &length); if ((length == 1) && (str[0] == '.')) { @@ -638,7 +638,7 @@ GetInvalidIntFromObj( Tcl_Obj *objPtr, int *intPtr) { - size_t length; + Tcl_Size length; const char *str = Tcl_GetStringFromObj(objPtr, &length); if ((length == 0) || ((length == 2) && (str[0] == '0') diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 747eea0..7edfd10 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)); @@ -1601,6 +1613,7 @@ ListRepRange( Tcl_Obj * TclListObjRange( + Tcl_Interp *interp, /* May be NULL. Used for error messages */ Tcl_Obj *listObj, /* List object to take a range from. */ Tcl_Size rangeStart, /* Index of first element to include. */ Tcl_Size rangeEnd) /* Index of last element to include. */ @@ -1609,7 +1622,7 @@ TclListObjRange( ListRep resultRep; int isShared; - if (TclListObjGetRep(NULL, listObj, &listRep) != TCL_OK) + if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) return NULL; isShared = Tcl_IsShared(listObj); @@ -2024,7 +2037,7 @@ Tcl_ListObjLength( return TCL_OK; } -Tcl_Size +Tcl_Size ListLength(Tcl_Obj *listPtr) { ListRep listRep; diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index d04776a..9051b45 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -560,7 +560,8 @@ TclHideLiteral( { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; - size_t localHash, length; + size_t localHash; + Tcl_Size length; const char *bytes; Tcl_Obj *newObjPtr; @@ -645,7 +646,7 @@ TclAddLiteralObj( if (litPtrPtr) { *litPtrPtr = lPtr; } - + return objIndex; } @@ -837,7 +838,8 @@ TclReleaseLiteral( LiteralTable *globalTablePtr; LiteralEntry *entryPtr, *prevPtr; const char *bytes; - size_t length, index; + size_t index; + Tcl_Size length; if (iPtr == NULL) { goto done; @@ -980,7 +982,8 @@ RebuildLiteralTable( LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; - size_t oldSize, count, index, length; + size_t oldSize, count, index; + Tcl_Size length; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 8e16b17..0a4bf58 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -3145,7 +3145,7 @@ NamespaceCodeCmd( Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; const char *arg; - size_t length; + Tcl_Size length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg"); diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index c9b0d5f..e644a2f 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -185,7 +185,7 @@ TclOO_Class_Create( { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); const char *objName; - size_t len; + Tcl_Size len; /* * Sanity check; should not be possible to invoke this method on a @@ -250,7 +250,7 @@ TclOO_Class_CreateNs( { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); const char *objName, *nsName; - size_t len; + Tcl_Size len; /* * Sanity check; should not be possible to invoke this method on a diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index bde8203..84204f9 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -704,7 +704,7 @@ TclOOUnknownDefinition( Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_HashSearch search; Tcl_HashEntry *hPtr; - size_t soughtLen; + Tcl_Size soughtLen; const char *soughtStr, *matchedStr = NULL; if (objc < 2) { @@ -778,7 +778,7 @@ FindCommand( Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { - size_t length; + Tcl_Size length; const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length); Namespace *const nsPtr = (Namespace *) namespacePtr; FOREACH_HASH_DECLS; @@ -997,16 +997,16 @@ GenerateErrorInfo( * an object, class or class-as-object that * was being configured. */ { - size_t length; + Tcl_Size length; Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr) ? savedNameObj : TclOOObjectName(interp, oPtr); const char *objName = Tcl_GetStringFromObj(realNameObj, &length); - unsigned limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT; + int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in definition script for %s \"%.*s%s\" line %d)", - typeOfSubject, (overflow ? limit : (unsigned)length), objName, + typeOfSubject, (overflow ? limit : (int)length), objName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } @@ -1534,7 +1534,7 @@ TclOODefineConstructorObjCmd( Object *oPtr; Class *clsPtr; Tcl_Method method; - size_t bodyLength; + Tcl_Size bodyLength; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arguments body"); @@ -1745,7 +1745,7 @@ TclOODefineDestructorObjCmd( Object *oPtr; Class *clsPtr; Tcl_Method method; - size_t bodyLength; + Tcl_Size bodyLength; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "body"); diff --git a/generic/tclObj.c b/generic/tclObj.c index 3735084..a978a09 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -617,7 +617,7 @@ TclContinuationsEnterDerived( int start, int *clNext) { - size_t length; + Tcl_Size length; int end, num; int *wordCLLast = clNext; diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c index e0a77aa..7a4a962 100644 --- a/generic/tclOptimize.c +++ b/generic/tclOptimize.c @@ -232,7 +232,7 @@ ConvertZeroEffectToNOP( && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt1AtPtr(currentInstPtr + 1)); - size_t numBytes; + Tcl_Size numBytes; (void) Tcl_GetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { @@ -247,7 +247,7 @@ ConvertZeroEffectToNOP( && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt4AtPtr(currentInstPtr + 1)); - size_t numBytes; + Tcl_Size numBytes; (void) Tcl_GetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index a59256f..abf9d6b 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -25,7 +25,7 @@ static void DupFsPathInternalRep(Tcl_Obj *srcPtr, static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); -static size_t FindSplitPos(const char *path, int separator); +static Tcl_Size FindSplitPos(const char *path, int separator); static int IsSeparatorOrNull(int ch); static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); static int MakePathFromNormalized(Tcl_Interp *interp, @@ -206,7 +206,7 @@ TclFSNormalizeAbsolutePath( /* * Need to skip '.' in the path. */ - size_t curLen; + Tcl_Size curLen; if (retVal == NULL) { const char *path = TclGetString(pathPtr); @@ -226,7 +226,7 @@ TclFSNormalizeAbsolutePath( } if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) { Tcl_Obj *linkObj; - size_t curLen; + Tcl_Size curLen; char *linkStr; /* @@ -305,7 +305,7 @@ TclFSNormalizeAbsolutePath( */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - size_t i; + Tcl_Size i; for (i = 0; i < curLen; i++) { if (linkStr[i] == '\\') { @@ -385,7 +385,7 @@ TclFSNormalizeAbsolutePath( */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - size_t len; + Tcl_Size len; const char *path = Tcl_GetStringFromObj(retVal, &len); if (len == 2 && path[0] != 0 && path[1] == ':') { @@ -559,7 +559,7 @@ TclPathPart( * the standardPath code. */ - size_t numBytes; + Tcl_Size numBytes; const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { @@ -596,7 +596,7 @@ TclPathPart( * we don't, and instead just use the standardPath code. */ - size_t numBytes; + Tcl_Size numBytes; const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { @@ -624,7 +624,7 @@ TclPathPart( return GetExtension(fsPathPtr->normPathPtr); case TCL_PATH_ROOT: { const char *fileName, *extension; - size_t length; + Tcl_Size length; fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &length); @@ -675,7 +675,7 @@ TclPathPart( if (portion == TCL_PATH_EXTENSION) { return GetExtension(pathPtr); } else if (portion == TCL_PATH_ROOT) { - size_t length; + Tcl_Size length; const char *fileName, *extension; fileName = Tcl_GetStringFromObj(pathPtr, &length); @@ -1166,7 +1166,7 @@ IsSeparatorOrNull( * of the end of the string. */ -static size_t +static Tcl_Size FindSplitPos( const char *path, int separator) @@ -1364,7 +1364,7 @@ TclFSMakePathRelative( Tcl_Obj *pathPtr, /* The path we have. */ Tcl_Obj *cwdPtr) /* Make it relative to this. */ { - size_t cwdLen, len; + Tcl_Size cwdLen, len; const char *tempStr; Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(pathPtr, &fsPathType); @@ -1632,7 +1632,7 @@ Tcl_FSGetTranslatedStringPath( Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr != NULL) { - size_t len; + Tcl_Size len; const char *orig = Tcl_GetStringFromObj(transPtr, &len); char *result = (char *)Tcl_Alloc(len+1); @@ -1682,7 +1682,7 @@ Tcl_FSGetNormalizedPath( */ Tcl_Obj *dir, *copy; - size_t tailLen, cwdLen; + Tcl_Size tailLen, cwdLen; int pathType; pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); @@ -1784,7 +1784,7 @@ Tcl_FSGetNormalizedPath( } fsPathPtr = PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { - size_t cwdLen; + Tcl_Size cwdLen; Tcl_Obj *copy; copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); @@ -2117,7 +2117,7 @@ Tcl_FSEqualPaths( Tcl_Obj *secondPtr) { const char *firstStr, *secondStr; - size_t firstLen, secondLen; + Tcl_Size firstLen, secondLen; int tempErrno; if (firstPtr == secondPtr) { @@ -2174,7 +2174,7 @@ SetFsPathFromAny( TCL_UNUSED(Tcl_Interp *), /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { - size_t len; + Tcl_Size len; FsPath *fsPathPtr; Tcl_Obj *transPtr; @@ -2326,7 +2326,7 @@ UpdateStringOfFsPath( Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); - size_t cwdLen; + Tcl_Size cwdLen; Tcl_Obj *copy; if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) { @@ -2398,7 +2398,7 @@ TclNativePathInFilesystem( * situation. */ - size_t len; + Tcl_Size len; (void) Tcl_GetStringFromObj(pathPtr, &len); if (len == 0) { @@ -2544,8 +2544,8 @@ TclResolveTildePath( Tcl_Obj *pathObj) { const char *path; - size_t len; - size_t split; + Tcl_Size len; + Tcl_Size split; Tcl_DString resolvedPath; path = Tcl_GetStringFromObj(pathObj, &len); diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 336018f..3ff7755 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -1160,7 +1160,7 @@ TclNRPackageObjCmd( break; } case PKG_IFNEEDED: { - size_t length; + Tcl_Size length; int res; char *argv3i, *avi; @@ -1399,7 +1399,7 @@ TclNRPackageObjCmd( } break; case PKG_UNKNOWN: { - size_t length; + Tcl_Size length; if (objc == 2) { if (iPtr->packageUnknown != NULL) { @@ -2072,7 +2072,7 @@ AddRequirementsToResult( { Tcl_Obj *result = Tcl_GetObjResult(interp); int i; - size_t length; + Tcl_Size length; for (i = 0; i < reqc; i++) { const char *v = Tcl_GetStringFromObj(reqv[i], &length); diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 1e6a2a9..dfdf12d 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -595,7 +595,7 @@ Tcl_GetRegExpFromObj( * expression. */ int flags) /* Regular expression compilation flags. */ { - size_t length; + Tcl_Size length; TclRegexp *regexpPtr; const char *pattern; diff --git a/generic/tclResult.c b/generic/tclResult.c index 29c36d1..c06a73a 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -354,7 +354,7 @@ Tcl_AppendElement( Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1); Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); const char *bytes; - size_t length; + Tcl_Size length; if (Tcl_IsShared(iPtr->objResultPtr)) { Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr)); @@ -718,7 +718,7 @@ TclProcessReturn( Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], &valuePtr); if (valuePtr != NULL) { - size_t length; + Tcl_Size length; (void) Tcl_GetStringFromObj(valuePtr, &length); if (length) { diff --git a/generic/tclScan.c b/generic/tclScan.c index ee18174..ecf8412 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,27 +307,31 @@ ValidateFormat( * format string. */ - value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ + long longVal = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ if (*end != '$') { goto notXpg; } + /* assert(longVal >= 0) because of the isdigit() check above */ format = end+1; format += TclUtfToUniChar(format, &ch); gotXpg = 1; if (gotSequential) { goto mixedXPG; } - objIndex = value - 1; - if ((objIndex < 0) || (numVars && (objIndex >= numVars))) { + objIndex = longVal - 1; + /* INT_MAX because 9.0 does not support more than INT_MAX-1 args */ + if ((objIndex < 0) || objIndex >= INT_MAX || + (numVars && (objIndex >= numVars))) { goto badIndex; - } else if (numVars == 0) { + } + 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 + * rules for growing the assign array. 'longVal' is guaranteed * to be > 0. */ - xpgSize = (xpgSize > value) ? xpgSize : value; + xpgSize = (xpgSize > longVal) ? xpgSize : longVal; } goto xpgCheckDone; } @@ -348,7 +353,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 +493,7 @@ ValidateFormat( * guaranteed to be at least one larger than objIndex. */ - value = nspace; + int nspaceOrig = nspace; if (xpgSize) { nspace = xpgSize; } else { @@ -481,7 +501,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 +595,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 +691,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 +705,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 +1092,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 +1108,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..fb7294b 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2006,12 +2006,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 +2052,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 == '*') { @@ -3512,6 +3525,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 +3580,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 +3624,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 +3641,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 +3657,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 +3668,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 { /* diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 4c24c68..b28f190 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -85,7 +85,9 @@ # undef TclGetUnicodeFromObj # define TclGetStringFromObj 0 # define TclGetBytesFromObj 0 -# define TclGetUnicodeFromObj 0 +# if TCL_UTF_MAX > 3 +# define TclGetUnicodeFromObj 0 +# endif #endif #undef Tcl_Close #define Tcl_Close 0 diff --git a/generic/tclTest.c b/generic/tclTest.c index 3a6ebba..9388110 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -2237,7 +2237,7 @@ TestencodingObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Encoding encoding; - size_t length; + Tcl_Size length; const char *string; TclEncoding *encodingPtr; static const char *const optionStrings[] = { @@ -4126,7 +4126,7 @@ PrintParse( Tcl_Obj *objPtr; const char *typeString; Tcl_Token *tokenPtr; - size_t i; + Tcl_Size i; objPtr = Tcl_GetObjResult(interp); if (parsePtr->commentSize + 1 > 1) { @@ -4140,7 +4140,7 @@ PrintParse( Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj(parsePtr->numWords)); - for (i = 0; i < (size_t)parsePtr->numTokens; i++) { + for (i = 0; i < parsePtr->numTokens; i++) { tokenPtr = &parsePtr->tokenPtr[i]; switch (tokenPtr->type) { case TCL_TOKEN_EXPAND_WORD: @@ -7323,7 +7323,7 @@ SimpleMatchInDirectory( origPtr = SimpleRedirect(dirPtr); res = Tcl_FSMatchInDirectory(interp, resPtr, origPtr, pattern, types); if (res == TCL_OK) { - size_t gLength, j; + Tcl_Size gLength, j; Tcl_ListObjLength(NULL, resPtr, &gLength); for (j = 0; j < gLength; j++) { Tcl_Obj *gElt, *nElt; @@ -7409,7 +7409,7 @@ TestUtfNextCmd( int objc, Tcl_Obj *const objv[]) { - size_t numBytes; + Tcl_Size numBytes; char *bytes; const char *result, *first; char buffer[32]; @@ -7422,7 +7422,7 @@ TestUtfNextCmd( } bytes = Tcl_GetStringFromObj(objv[1], &numBytes); - if (numBytes + 4U > sizeof(buffer)) { + if (numBytes + 4 > (Tcl_Size) sizeof(buffer)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes", sizeof(buffer) - 4)); @@ -7888,7 +7888,7 @@ TestconcatobjCmd( { Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr; int result = TCL_OK; - size_t len; + Tcl_Size len; Tcl_Obj *objv[3]; /* @@ -8245,7 +8245,7 @@ TestparseargsCmd( Tcl_Obj *const objv[]) /* Arguments. */ { static int foo = 0; - size_t count = objc; + Tcl_Size count = objc; Tcl_Obj **remObjv, *result[3]; Tcl_ArgvInfo argTable[] = { {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL}, diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 70c7b6a..0d17fa5 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -787,7 +787,7 @@ Tcl_AfterObjCmd( Tcl_Time wakeup; AfterInfo *afterPtr; AfterAssocData *assocPtr; - size_t length; + Tcl_Size length; int index = -1; static const char *const afterSubCmds[] = { "cancel", "idle", "info", NULL @@ -882,7 +882,7 @@ Tcl_AfterObjCmd( case AFTER_CANCEL: { Tcl_Obj *commandPtr; const char *command, *tempCommand; - size_t tempLength; + Tcl_Size tempLength; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "id|command"); diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h index 40a4e9d..26db082 100644 --- a/generic/tclTomMath.h +++ b/generic/tclTomMath.h @@ -24,6 +24,14 @@ # define MP_VAL -3 /* invalid input */ # define MP_ITER -4 /* maximum iterations reached */ # define MP_BUF -5 /* buffer overflow, supplied buffer too small */ + typedef int mp_order; +# define MP_LSB_FIRST -1 +# define MP_MSB_FIRST 1 + typedef int mp_endian; +# define MP_LITTLE_ENDIAN -1 +# define MP_NATIVE_ENDIAN 0 +# define MP_BIG_ENDIAN 1 +# define MP_DEPRECATED_PRAGMA(s) /* nothing */ # define MP_WUR /* nothing */ # define mp_iszero(a) ((a)->used == 0) # define mp_isneg(a) ((a)->sign != 0) diff --git a/generic/tclVar.c b/generic/tclVar.c index 63bcf19..550d7a6 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -842,7 +842,7 @@ TclLookupSimpleVar( Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; int isNew, i, result; - size_t varLen; + Tcl_Size varLen; const char *varName = Tcl_GetStringFromObj(varNamePtr, &varLen); varPtr = NULL; @@ -972,7 +972,7 @@ TclLookupSimpleVar( if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; - size_t localLen; + Tcl_Size localLen; for (i=0 ; i<localCt ; i++, objPtrPtr++) { Tcl_Obj *objPtr = *objPtrPtr; diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 446aeb2..48e7415 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -2280,7 +2280,7 @@ ZipFSMountBufferObjCmd( { const char *mountPoint; /* Mount point path. */ unsigned char *data; - size_t length; + Tcl_Size length; if (objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?"); @@ -2391,7 +2391,7 @@ ZipFSMkKeyObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t len, i = 0; + Tcl_Size len, i = 0; const char *pw; Tcl_Obj *passObj; unsigned char *passBuf; @@ -2409,7 +2409,7 @@ ZipFSMkKeyObjCmd( } passObj = Tcl_NewByteArrayObj(NULL, 264); - passBuf = Tcl_GetByteArrayFromObj(passObj, (size_t *)NULL); + passBuf = Tcl_GetByteArrayFromObj(passObj, (Tcl_Size *)NULL); while (len > 0) { int ch = pw[len - 1]; @@ -2516,7 +2516,8 @@ ZipAddFile( * UTF-8). */ const char *zpathTcl; /* Filename in Tcl's internal encoding. */ int crc, flush, zpathlen; - size_t nbyte, nbytecompr, len, olen, align = 0; + size_t nbyte, nbytecompr; + Tcl_Size len, olen, align = 0; long long headerStartOffset, dataStartOffset, dataEndOffset; int mtime = 0, isNew, compMeth; unsigned long keys[3], keys0[3]; @@ -2540,7 +2541,7 @@ ZipAddFile( * crazy enough to embed NULs in filenames, they deserve what they get! */ - zpathExt = Tcl_UtfToExternalDString(ZipFS.utf8, zpathTcl, TCL_INDEX_NONE, &zpathDs); + zpathExt = Tcl_UtfToExternalDString(ZipFS.utf8, zpathTcl, -1, &zpathDs); zpathlen = strlen(zpathExt); if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -2578,7 +2579,7 @@ ZipAddFile( nbyte = nbytecompr = 0; while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == (size_t) TCL_INDEX_NONE) { + if (len < 0) { Tcl_DStringFree(&zpathDs); if (nbyte == 0 && errno == EISDIR) { Tcl_Close(interp, in); @@ -2619,7 +2620,7 @@ ZipAddFile( memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpathExt, zpathlen); len = zpathlen + ZIP_LOCAL_HEADER_LEN; - if ((size_t) Tcl_Write(out, buf, len) != len) { + if (Tcl_Write(out, buf, len) != len) { writeErrorWithChannelOpen: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error on \"%s\": %s", @@ -2643,7 +2644,7 @@ ZipAddFile( ZipWriteShort(astart, aend, abuf, 0xffff); ZipWriteShort(astart, aend, abuf + 2, align - 4); ZipWriteInt(astart, aend, abuf + 4, 0x03020100); - if ((size_t) Tcl_Write(out, (const char *) abuf, align) != align) { + if (Tcl_Write(out, (const char *) abuf, align) != align) { goto writeErrorWithChannelOpen; } } @@ -2708,7 +2709,7 @@ ZipAddFile( do { len = Tcl_Read(in, buf, bufsize); - if (len == (size_t) TCL_INDEX_NONE) { + if (len < 0) { deflateEnd(&stream); goto readErrorWithChannelOpen; } @@ -2719,7 +2720,7 @@ ZipAddFile( stream.avail_out = sizeof(obuf); stream.next_out = (unsigned char *) obuf; len = deflate(&stream, flush); - if (len == (size_t) Z_STREAM_ERROR) { + if (len == Z_STREAM_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "deflate error on \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "DEFLATE"); @@ -2730,14 +2731,14 @@ ZipAddFile( } olen = sizeof(obuf) - stream.avail_out; if (passwd) { - size_t i; + Tcl_Size i; int tmp; for (i = 0; i < olen; i++) { obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); } } - if (olen && ((size_t) Tcl_Write(out, obuf, olen) != olen)) { + if (olen && (Tcl_Write(out, obuf, olen) != olen)) { deflateEnd(&stream); goto writeErrorWithChannelOpen; } @@ -2772,20 +2773,20 @@ ZipAddFile( nbytecompr = (passwd ? 12 : 0); while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == (size_t) TCL_INDEX_NONE) { + if (len < 0) { goto readErrorWithChannelOpen; } else if (len == 0) { break; } if (passwd) { - size_t i; + Tcl_Size i; int tmp; for (i = 0; i < len; i++) { buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); } } - if ((size_t) Tcl_Write(out, buf, len) != len) { + if (Tcl_Write(out, buf, len) != len) { goto writeErrorWithChannelOpen; } nbytecompr += len; @@ -2918,11 +2919,11 @@ ComputeNameInArchive( * archive */ const char *strip, /* A prefix to strip; may be NULL if no * stripping need be done. */ - size_t slen) /* The length of the prefix; must be 0 if no + Tcl_Size slen) /* The length of the prefix; must be 0 if no * stripping need be done. */ { const char *name; - size_t len; + Tcl_Size len; if (directNameObj) { name = TclGetString(directNameObj); @@ -2991,7 +2992,7 @@ ZipFSMkZipOrImg( { Tcl_Channel out; int count, ret = TCL_ERROR; - size_t pwlen = 0, slen = 0, len, i = 0; + Tcl_Size pwlen = 0, slen = 0, len, i = 0; Tcl_Size lobjc; long long directoryStartOffset; /* The overall file offset of the start of the @@ -3178,7 +3179,7 @@ ZipFSMkZipOrImg( strip = NULL; } } - for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) { + for (i = 0; i < lobjc; i += (mappingList ? 2 : 1)) { Tcl_Obj *pathObj = lobjv[i]; const char *name = ComputeNameInArchive(pathObj, (mappingList ? lobjv[i + 1] : NULL), strip, slen); @@ -3198,7 +3199,7 @@ ZipFSMkZipOrImg( directoryStartOffset = Tcl_Tell(out); count = 0; - for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) { + for (i = 0; i < lobjc; i += (mappingList ? 2 : 1)) { const char *name = ComputeNameInArchive(lobjv[i], (mappingList ? lobjv[i + 1] : NULL), strip, slen); Tcl_DString ds; @@ -3215,7 +3216,7 @@ ZipFSMkZipOrImg( z, len); if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN) - || ((size_t) Tcl_Write(out, name, len) != len)) { + || (Tcl_Write(out, name, len) != len)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); Tcl_DStringFree(&ds); @@ -3282,8 +3283,8 @@ CopyImageFile( Tcl_Channel out) /* Where to copy to; already open for writing * binary data. */ { - size_t i, k; - int m, n; + Tcl_WideInt i, k; + Tcl_Size m, n; Tcl_Channel in; char buf[4096]; const char *errMsg; @@ -3299,7 +3300,7 @@ CopyImageFile( */ i = Tcl_Seek(in, 0, SEEK_END); - if (i == (size_t) TCL_INDEX_NONE) { + if (i == -1) { errMsg = "seek error"; goto copyError; } @@ -3312,8 +3313,8 @@ CopyImageFile( for (k = 0; k < i; k += m) { m = i - k; - if (m > (int) sizeof(buf)) { - m = (int) sizeof(buf); + if (m > (Tcl_Size) sizeof(buf)) { + m = sizeof(buf); } n = Tcl_Read(in, buf, m); if (n == -1) { @@ -5002,8 +5003,8 @@ ZipFSMatchInDirectoryProc( Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); - int scnt, l, dirOnly = -1, strip = 0, mounts = 0; - size_t prefixLen, len; + int scnt, l, dirOnly = -1, mounts = 0; + Tcl_Size prefixLen, len, strip = 0; char *pat, *prefix, *path; Tcl_DString dsPref, *prefixBuf = NULL; @@ -5139,7 +5140,8 @@ ZipFSMatchMountPoints( { Tcl_HashEntry *hPtr; Tcl_HashSearch search; - size_t l, normLength; + size_t l; + Tcl_Size normLength; const char *path = Tcl_GetStringFromObj(normPathPtr, &normLength); size_t len = normLength; @@ -5221,7 +5223,7 @@ ZipFSPathInFilesystemProc( Tcl_HashEntry *hPtr; Tcl_HashSearch search; int ret = -1; - size_t len; + Tcl_Size len; char *path; pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); @@ -5248,9 +5250,9 @@ ZipFSPathInFilesystemProc( ZipEntry *z; for (z = zf->topEnts; z != NULL; z = z->tnext) { - size_t lenz = strlen(z->name); + Tcl_Size lenz = strlen(z->name); - if (((size_t) len >= lenz) && + if ((len >= lenz) && (strncmp(path, z->name, lenz) == 0)) { ret = TCL_OK; goto endloop; @@ -5368,7 +5370,7 @@ ZipFSFileAttrsGetProc( Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) { - size_t len; + Tcl_Size len; int ret = TCL_OK; char *path; ZipEntry *z; diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 8c6ab10..1399ec9 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -423,7 +423,7 @@ GenerateHeader( { Tcl_Obj *value; int len, result = TCL_ERROR; - size_t length; + Tcl_Size length; Tcl_WideInt wideValue = 0; const char *valueStr; Tcl_Encoding latin1enc; @@ -624,7 +624,7 @@ SetInflateDictionary( Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - size_t length = 0; + Tcl_Size length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); if (bytes == NULL) { @@ -641,7 +641,7 @@ SetDeflateDictionary( Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - size_t length = 0; + Tcl_Size length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); if (bytes == NULL) { @@ -1191,7 +1191,7 @@ Tcl_ZlibStreamSetCompressionDictionary( ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; if (compressionDictionaryObj && (NULL == Tcl_GetByteArrayFromObj( - compressionDictionaryObj, (size_t *)NULL))) { + compressionDictionaryObj, (Tcl_Size *)NULL))) { /* Missing or invalid compression dictionary */ compressionDictionaryObj = NULL; } @@ -1234,7 +1234,8 @@ Tcl_ZlibStreamPut( ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; char *dataTmp = NULL; int e; - size_t size = 0, outSize, toStore; + Tcl_Size size = 0; + size_t outSize, toStore; unsigned char *bytes; if (zshPtr->streamEnd) { @@ -1616,7 +1617,7 @@ Tcl_ZlibDeflate( Tcl_Obj *gzipHeaderDictObj) { int wbits = 0, e = 0, extraSize = 0; - size_t inLen = 0; + Tcl_Size inLen = 0; Byte *inData = NULL; z_stream stream; GzipHeader header; @@ -1989,7 +1990,9 @@ ZlibCmd( Tcl_Obj *const objv[]) { int i, option, level = -1; - size_t dlen = 0, start, buffersize = 0; + size_t buffersize = 0; + Tcl_Size dlen = 0; + unsigned int start; Tcl_WideInt wideLen; Byte *data; Tcl_Obj *headerDictObj; @@ -2387,7 +2390,7 @@ ZlibStreamSubcmd( } if (compDictObj) { - if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL)) { + if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (Tcl_Size *)NULL)) { return TCL_ERROR; } } @@ -2570,7 +2573,7 @@ ZlibPushSubcmd( } } - if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL))) { + if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (Tcl_Size *)NULL))) { return TCL_ERROR; } @@ -2817,7 +2820,7 @@ ZlibStreamAddCmd( */ if (compDictObj != NULL) { - size_t len = 0; + Tcl_Size len = 0; if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, &len)) { return TCL_ERROR; @@ -2924,7 +2927,7 @@ ZlibStreamPutCmd( */ if (compDictObj != NULL) { - size_t len = 0; + Tcl_Size len = 0; if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, &len)) { return TCL_ERROR; @@ -3367,7 +3370,7 @@ ZlibTransformSetOption( /* not used */ TclNewStringObj(compDictObj, value, strlen(value)); Tcl_IncrRefCount(compDictObj); - if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL)) { + if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (Tcl_Size *)NULL)) { Tcl_DecrRefCount(compDictObj); return TCL_ERROR; } @@ -3517,7 +3520,7 @@ ZlibTransformGetOption( } } else { if (cd->compDictObj) { - size_t length; + Tcl_Size length; const char *str = Tcl_GetStringFromObj(cd->compDictObj, &length); Tcl_DStringAppend(dsPtr, str, length); diff --git a/tests/bigdata.test b/tests/bigdata.test index ced2510..c02d8e3 100644 --- a/tests/bigdata.test +++ b/tests/bigdata.test @@ -139,9 +139,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 +151,15 @@ 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 +} +# -constraints bug-a814ee5bbd # # string first @@ -550,7 +549,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 +558,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 +681,17 @@ 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 +} +# -constraints bug-9369f83649 +# 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 +707,18 @@ 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 +} +# -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 +744,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 +766,7 @@ bigtestRO binary-encode/decode-uuencode-bigdata-1 "binary encode/decode uuencode set bin [bigBinary 4294967296] } -cleanup { bigClean -} -constraints bug-2e3fed53ba +} ################################################################ # List commands @@ -752,17 +800,17 @@ bigtest lappend-bigdata-1 "lappend" {4294967300 4294967300 {1 2 3 4 5 a b c d}} # # lassign -bigtestRO lassign-bigdata-1 "lassign" {0 1 2 3 4 5 6 7 8 9 1} -body { +bigtestRO lassign-bigdata-1 "lassign" {0 1 2 3 4 5 6 7 8 {9 0 1 2 3 4 5 6 7 8} {6 7 8 9 0 1 2 3 4 5}} -body { # Unset explicitly before setting to save memory as bigtestRO runs the # script below twice. unset -nocomplain l2 - set l2 [lassign $l a b c d e f g h i j] - list $a $b $c $d $e $f $g $h $i $j [testlutil equal $l2 [bigList 0x100000000]] + set l2 [lassign $l a b c d e f g h i] + list $a $b $c $d $e $f $g $h $i [lrange $l2 0 9] [lrange $l2 end-9 end] } -setup { set l [bigList 0x10000000a] } -cleanup { bigClean -} -constraints bug-d90fee06d0 +} # # ledit diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 5a68925..b24b10c 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -168,6 +168,9 @@ test cmdIL-1.41 {lsort -stride and -index} -body { test cmdIL-1.42 {lsort -stride and-index} -body { lsort -stride 2 -index -1-1 {a 2 b 1} } -returnCodes error -result {index "-1-1" out of range} +test cmdIL-1.43 {lsort -stride errors} -returnCodes error -body { + lsort -stride 4294967296 bar +} -result {list size must be a multiple of the stride length} # Can't think of any good tests for the MergeSort and MergeLists procedures, # except a bunch of random lists to sort. diff --git a/tests/lsearch.test b/tests/lsearch.test index 7c1402d..b8a8aa7 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.test @@ -688,6 +688,9 @@ test lsearch-28.8 {lsearch -sorted with -stride} -body { test lsearch-28.9 {lsearch -sorted with -stride} -body { lsearch -sorted -stride 2 -index 1 -subindices -inline {3 5 8 7 2 9} 9 } -result 9 +test lsearch-28.10 {lsearch -sorted with -stride} -body { + lsearch -sorted -stride 4294967296 -index 1 -subindices -inline {3 5 8 7 2 9} 9 +} -returnCodes 1 -result {list size must be a multiple of the stride length} # cleanup diff --git a/tests/lseq.test b/tests/lseq.test index 7e4c9da..6bf89eb 100755 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -416,7 +416,7 @@ 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.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} @@ -568,12 +568,12 @@ test lseq-4.13 {bug lseq} -constraints has64BitLengths -body { } -result {9223372036854775807 9223372036854775806 9223372036854775800} -test lseq-4.14 {bug lseq - inconsistent rounding} { +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} { +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} 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/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 8109202..b260cf4 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -1504,7 +1504,7 @@ SetGroupAttribute( Tcl_DString ds; struct group *groupPtr = NULL; const char *string; - size_t length; + Tcl_Size length; string = Tcl_GetStringFromObj(attributePtr, &length); @@ -1571,7 +1571,7 @@ SetOwnerAttribute( Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; - size_t length; + Tcl_Size length; string = Tcl_GetStringFromObj(attributePtr, &length); @@ -1947,7 +1947,7 @@ TclpObjNormalizePath( { const char *currentPathEndPosition; char cur; - size_t pathLen; + Tcl_Size pathLen; const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); Tcl_DString ds; const char *nativePath; @@ -2171,7 +2171,7 @@ TclUnixOpenTemporaryFile( Tcl_DString templ, tmp; const char *string; int fd; - size_t length; + Tcl_Size length; /* * We should also check against making more then TMP_MAX of these. diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 50ee64d..41985ab 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -946,7 +946,7 @@ TclpObjLink( if (linkAction & TCL_CREATE_SYMBOLIC_LINK) { Tcl_DString ds; Tcl_Obj *transPtr; - size_t length; + Tcl_Size length; /* * Now we don't want to link to the absolute, normalized path. @@ -1087,7 +1087,7 @@ TclNativeCreateNativeRep( const char *str; Tcl_DString ds; Tcl_Obj *validPathPtr; - size_t len; + Tcl_Size len; if (TclFSCwdIsNative()) { /* diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 9d1c192..1aecbd8 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -544,9 +544,17 @@ TclpInitLibraryPath( Tcl_DStringFree(&buffer); *encodingPtr = Tcl_GetEncoding(NULL, NULL); - str = Tcl_GetStringFromObj(pathPtr, lengthPtr); - *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); - memcpy(*valuePtr, str, *lengthPtr + 1); + + /* + * 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; + str = Tcl_GetStringFromObj(pathPtr, &length); + *lengthPtr = length; + *valuePtr = (char *)Tcl_Alloc(length + 1); + memcpy(*valuePtr, str, length + 1); Tcl_DecrRefCount(pathPtr); } |