From b794cb03e1ffc8d198a9cd1e0b7d8ae1406b258f Mon Sep 17 00:00:00 2001 From: pooryorick Date: Fri, 21 Apr 2023 09:19:51 +0000 Subject: Set the encoding profile to strict in Tcl_FSEvalFileEx(). --- generic/tclIOUtil.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index f2f91a7..ae44518 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1734,6 +1734,11 @@ Tcl_FSEvalFileEx( Tcl_CloseEx(interp,chan,0); return result; } + if (Tcl_SetChannelOption(interp, chan, "-profile", "strict") + != TCL_OK) { + Tcl_CloseEx(interp,chan,0); + return result; + } TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); -- cgit v0.12 From d39298874a1bc2665f1af0712f4798f82b7067fe Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 21 Apr 2023 10:07:08 +0000 Subject: Fix gcc warning about format specifier in error message --- generic/tclCmdIL.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index c5a6616..dbc74bd 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2940,7 +2940,7 @@ Tcl_LrepeatObjCmd( } if (elementCount < 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad count \"%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; -- cgit v0.12 From 1fe7d754ed84d81bf0fb2928b1bccfc96348bd12 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 21 Apr 2023 20:18:54 +0000 Subject: Reduce diff between 8.7 and 9.0. Add some testcases --- generic/tclCmdIL.c | 87 ++++++++------- generic/tclStringObj.c | 295 +++++++++++++++++++++++++------------------------ tests/cmdIL.test | 5 +- tests/lsearch.test | 5 +- 4 files changed, 206 insertions(+), 186 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index b1ee1f4..f6d3df3 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -39,7 +39,7 @@ typedef struct SortElement { } collationKey; union { /* Object being sorted, or its index. */ Tcl_Obj *objPtr; - int index; + Tcl_Size index; } payload; struct SortElement *nextPtr;/* Next element in the list, or NULL for end * of list. */ @@ -51,7 +51,6 @@ typedef struct SortElement { */ typedef int (*SortStrCmpFn_t) (const char *, const char *); -typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t); /* * The "lsort" command needs to pass certain information down to the function @@ -74,7 +73,7 @@ typedef struct { * NULL if no indexes supplied, and points to * singleIndex field when only one * supplied. */ - int indexc; /* Number of indexes in indexv array. */ + Tcl_Size indexc; /* Number of indexes in indexv array. */ int singleIndex; /* Static space for common index case. */ int unique; int numElements; @@ -541,7 +540,7 @@ InfoBodyCmd( Interp *iPtr = (Interp *) interp; const char *name, *bytes; Proc *procPtr; - int numBytes; + Tcl_Size numBytes; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); @@ -651,7 +650,7 @@ InfoCommandsCmd( Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_Command cmd; - int i; + Tcl_Size i; /* * Get the pattern and find the "effective namespace" in which to list @@ -1397,7 +1396,7 @@ TclInfoFrame( ADD_PAIR("proc", procNameObj); } else if (procPtr->cmdPtr->clientData) { ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData; - int i; + Tcl_Size i; /* * This is a non-standard command. Luckily, it's told us how to @@ -2202,7 +2201,8 @@ Tcl_JoinObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - int length, listLen, isArithSeries = 0; + Tcl_Size length, listLen; + int isArithSeries = 0; Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs; if ((objc < 2) || (objc > 3)) { @@ -2250,7 +2250,7 @@ Tcl_JoinObjCmd( if (length == 0) { resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0); } else { - int i; + Tcl_Size i; TclNewObj(resObjPtr); if (isArithSeries) { @@ -2325,7 +2325,7 @@ Tcl_LassignObjCmd( { Tcl_Obj *listCopyPtr; Tcl_Obj **listObjv; /* The contents of the list. */ - int listObjc; /* The length of the list. */ + Tcl_Size listObjc; /* The length of the list. */ int code = TCL_OK; if (objc < 2) { @@ -2456,7 +2456,8 @@ Tcl_LinsertObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; - int index, len, result; + Tcl_Size len, index; + int result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?"); @@ -2574,7 +2575,8 @@ Tcl_LlengthObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { - int listLen, result; + Tcl_Size listLen; + int result; Tcl_Obj *objPtr; if (objc != 2) { @@ -2622,7 +2624,8 @@ Tcl_LpopObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { - int listLen, result; + Tcl_Size listLen; + int result; Tcl_Obj *elemPtr, *stored; Tcl_Obj *listPtr, **elemPtrs; @@ -2723,7 +2726,8 @@ Tcl_LrangeObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { - int listLen, first, last, result; + int result; + Tcl_Size listLen, first, last; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); return TCL_ERROR; @@ -2782,8 +2786,8 @@ LremoveIndexCompare( const void *el1Ptr, const void *el2Ptr) { - int idx1 = *((const int *) el1Ptr); - int idx2 = *((const int *) el2Ptr); + Tcl_Size idx1 = *((const Tcl_Size *) el1Ptr); + Tcl_Size idx2 = *((const Tcl_Size *) el2Ptr); /* * This will put the larger element first. @@ -2799,8 +2803,8 @@ Tcl_LremoveObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, idxc, listLen, prevIdx, first, num; - int *idxv; + Tcl_Size i, idxc, prevIdx, first, num; + Tcl_Size *idxv, listLen; Tcl_Obj *listObj; /* @@ -2822,7 +2826,7 @@ Tcl_LremoveObjCmd( Tcl_SetObjResult(interp, listObj); return TCL_OK; } - idxv = (int *)ckalloc((objc - 2) * sizeof(int)); + idxv = (Tcl_Size *)Tcl_Alloc((objc - 2) * sizeof(*idxv)); for (i = 2; i < objc; i++) { if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1, &idxv[i - 2]) != TCL_OK) { @@ -2837,7 +2841,7 @@ Tcl_LremoveObjCmd( */ if (idxc > 1) { - qsort(idxv, idxc, sizeof(int), LremoveIndexCompare); + qsort(idxv, idxc, sizeof(*idxv), LremoveIndexCompare); } /* @@ -2850,7 +2854,7 @@ Tcl_LremoveObjCmd( num = 0; first = listLen; for (i = 0, prevIdx = -1 ; i < idxc ; i++) { - int idx = idxv[i]; + Tcl_Size idx = idxv[i]; /* * Repeated index and sanity check. @@ -2919,7 +2923,8 @@ Tcl_LrepeatObjCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { - int elementCount, i, totalElems; + Tcl_WideInt elementCount, i; + Tcl_Size totalElems; Tcl_Obj *listPtr, **dataArray = NULL; /* @@ -2931,12 +2936,12 @@ Tcl_LrepeatObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?"); return TCL_ERROR; } - if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) { + if (TCL_OK != TclGetWideIntFromObj(interp, objv[1], &elementCount)) { return TCL_ERROR; } if (elementCount < 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad count \"%d\": must be integer >= 0", elementCount)); + "bad count \"%" TCL_LL_MODIFIER "d\": must be integer >= 0", elementCount)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG", NULL); return TCL_ERROR; @@ -2993,7 +2998,7 @@ Tcl_LrepeatObjCmd( dataArray[i] = tmpPtr; } } else { - int j, k = 0; + Tcl_Size j, k = 0; for (i=0 ; i LIST_MAX)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "stride length must be between 1 and %d", LIST_MAX)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE", NULL); result = TCL_ERROR; goto done; } + groupSize = wide; i++; break; case LSEARCH_INDEX: { /* -index */ Tcl_Obj **indices; - int j; + Tcl_Size j; if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); @@ -4485,6 +4492,7 @@ Tcl_LsortObjCmd( int group, groupSize, groupOffset, idx, allocatedIndexVector = 0; Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr; size_t elmArrSize; + Tcl_WideInt wide; SortElement *elementArray = NULL, *elementPtr; SortInfo sortInfo; /* Information about this sort that needs to * be passed to the comparison function. */ @@ -4634,18 +4642,19 @@ Tcl_LsortObjCmd( sortInfo.resultCode = TCL_ERROR; goto done; } - if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; } - if (groupSize < 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "stride length must be at least 2", -1)); + if ((wide < 2) || (wide > LIST_MAX)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "stride length must be between 2 and %d", LIST_MAX)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } + groupSize = wide; group = 1; i++; break; diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index a6ed49f..010d822 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -46,28 +46,28 @@ static void AppendPrintfToObjVA(Tcl_Obj *objPtr, const char *format, va_list argList); static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int appendNumChars); + const Tcl_UniChar *unicode, Tcl_Size appendNumChars); static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); + const Tcl_UniChar *unicode, Tcl_Size numChars); static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, - const char *bytes, int numBytes); + const char *bytes, Tcl_Size numBytes); static void AppendUtfToUtfRep(Tcl_Obj *objPtr, - const char *bytes, int numBytes); + const char *bytes, Tcl_Size numBytes); static void DupStringInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); -static int ExtendStringRepWithUnicode(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); +static Tcl_Size ExtendStringRepWithUnicode(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, Tcl_Size numChars); static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, - const char *bytes, int numBytes, - int numAppendChars); + const char *bytes, Tcl_Size numBytes, + Tcl_Size numAppendChars); static void FillUnicodeRep(Tcl_Obj *objPtr); static void FreeStringInternalRep(Tcl_Obj *objPtr); static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag); static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); -static int UnicodeLength(const Tcl_UniChar *unicode); + const Tcl_UniChar *unicode, Tcl_Size numChars); +static Tcl_Size UnicodeLength(const Tcl_UniChar *unicode); #if !defined(TCL_NO_DEPRECATED) static int UTF16Length(const unsigned short *unicode); #endif @@ -425,7 +425,7 @@ Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length) /* The number of bytes to copy from "bytes" + Tcl_Size length) /* The number of bytes to copy from "bytes" * when initializing the new object. If * negative, use bytes up to the first NUL * byte. */ @@ -437,10 +437,9 @@ Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length) /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first NUL - * byte. */ + Tcl_Size length) /* The number of bytes to copy from "bytes" + * when initializing the new object. If negative, + * use bytes up to the first NUL byte. */ { Tcl_Obj *objPtr; @@ -717,7 +716,7 @@ int TclCheckEmptyString( Tcl_Obj *objPtr) { - int length = -1; + Tcl_Size length = TCL_INDEX_NONE; if (objPtr->bytes == &tclEmptyString) { return TCL_EMPTYSTRING_YES; @@ -763,10 +762,10 @@ int Tcl_GetUniChar( Tcl_Obj *objPtr, /* The object to get the Unicode charater * from. */ - int index) /* Get the index'th Unicode character. */ + Tcl_Size index) /* Get the index'th Unicode character. */ { String *stringPtr; - int ch, length; + int ch; if (index < 0) { return -1; @@ -778,6 +777,7 @@ Tcl_GetUniChar( */ if (TclIsPureByteArray(objPtr)) { + Tcl_Size length; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (index >= length) { return -1; @@ -819,21 +819,22 @@ int TclGetUniChar( Tcl_Obj *objPtr, /* The object to get the Unicode character * from. */ - int index) /* Get the index'th Unicode character. */ + Tcl_Size index) /* Get the index'th Unicode character. */ { UniCharString *stringPtr; - int ch, length; + int ch; if (index < 0) { return -1; } /* - * Optimize the case where we're really dealing with a ByteArray object - * we don't need to convert to a string to perform the indexing operation. + * Optimize the ByteArray case: N need need to convert to a string to + * perform the indexing operation. */ if (TclIsPureByteArray(objPtr)) { + Tcl_Size length; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (index >= length) { return -1; @@ -939,10 +940,10 @@ Tcl_GetUnicode( Tcl_UniChar * TclGetUnicodeFromObj_( - Tcl_Obj *objPtr, /* The object to find the unicode string + Tcl_Obj *objPtr, /* The object to find the Unicode string * for. */ int *lengthPtr) /* If non-NULL, the location where the string - * rep's unichar length should be stored. If + * rep's Tcl_UniChar length should be stored. If * NULL, no length is stored. */ { UniCharString *stringPtr; @@ -1014,9 +1015,9 @@ TclGetUnicodeFromObj( * * Create a Tcl Object that contains the chars between first and last of * the object indicated by "objPtr". If the object is not already a - * String object, convert it to one. If first is negative, the returned - * string start at the beginning of objPtr. If last is negative, the - * returned string ends at the end of objPtr. + * String object, convert it to one. If first is negative, the + * returned string start at the beginning of objPtr. If last is + * negative, the returned string ends at the end of objPtr. * * Results: * Returns a new Tcl Object of the String type. @@ -1119,7 +1120,7 @@ TclGetRange( * If numChars is unknown, compute it. */ - if (stringPtr->numChars == -1) { + if (stringPtr->numChars == TCL_INDEX_NONE) { TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { @@ -1192,7 +1193,7 @@ Tcl_SetStringObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ const char *bytes, /* Points to the first of the length bytes * used to initialize the object. */ - int length) /* The number of bytes to copy from "bytes" + Tcl_Size length) /* The number of bytes to copy from "bytes" * when initializing the object. If negative, * use bytes up to the first NUL byte.*/ { @@ -1223,20 +1224,19 @@ Tcl_SetStringObj( * * Tcl_SetObjLength -- * - * This function changes the length of the string representation of an - * object. + * Changes the length of the string representation of objPtr. * * Results: * None. * * Side effects: - * If the size of objPtr's string representation is greater than length, - * then it is reduced to length and a new terminating null byte is stored - * in the strength. If the length of the string representation is greater - * than length, the storage space is reallocated to the given length; a - * null byte is stored at the end, but other bytes past the end of the - * original string representation are undefined. The object's internal - * representation is changed to "expendable string". + * If the size of objPtr's string representation is greater than length, a + * new terminating null byte is stored in objPtr->bytes at length, and + * bytes at positions past length have no meaning. If the length of the + * string representation is greater than length, the storage space is + * reallocated to length+1. + * + * The object's internal representation is changed to &tclStringType. * *---------------------------------------------------------------------- */ @@ -1245,20 +1245,15 @@ void Tcl_SetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - int length) /* Number of bytes desired for string + Tcl_Size length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { UniCharString *stringPtr; if (length < 0) { - /* - * Setting to a negative length is nonsense. This is probably the - * result of overflowing the signed integer range. - */ - - Tcl_Panic("Tcl_SetObjLength: negative length requested: " - "%d (integer overflow?)", length); + Tcl_Panic("Tcl_SetObjLength: length requested is negative: " + "%" TCL_SIZE_MODIFIER "d (integer overflow?)", length); } if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetObjLength"); @@ -1291,10 +1286,10 @@ Tcl_SetObjLength( objPtr->bytes[length] = 0; /* - * Invalidate the unicode data. + * Invalidate the Unicode data. */ - stringPtr->numChars = -1; + stringPtr->numChars = TCL_INDEX_NONE; stringPtr->hasUnicode = 0; } else { /* @@ -1350,20 +1345,17 @@ int Tcl_AttemptSetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - int length) /* Number of bytes desired for string + Tcl_Size length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { UniCharString *stringPtr; if (length < 0) { - /* - * Setting to a negative length is nonsense. This is probably the - * result of overflowing the signed integer range. - */ - + /* Negative lengths => most likely integer overflow */ return 0; } + if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength"); } @@ -1404,7 +1396,7 @@ Tcl_AttemptSetObjLength( * Invalidate the Unicode data. */ - stringPtr->numChars = -1; + stringPtr->numChars = TCL_INDEX_NONE; stringPtr->hasUnicode = 0; } else { /* @@ -1505,14 +1497,14 @@ UTF16Length( } #endif -static int +static Tcl_Size UnicodeLength( const Tcl_UniChar *unicode) { - int numChars = 0; + Tcl_Size numChars = 0; if (unicode) { - while (numChars >= 0 && unicode[numChars] != 0) { + while ((numChars >= 0) && (unicode[numChars] != 0)) { numChars++; } } @@ -1525,7 +1517,7 @@ SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ const Tcl_UniChar *unicode, /* The Unicode string used to initialize the * object. */ - int numChars) /* Number of characters in the Unicode + Tcl_Size numChars) /* Number of characters in the Unicode * string. */ { UniCharString *stringPtr; @@ -1576,18 +1568,18 @@ Tcl_AppendLimitedToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ - int length, /* The number of bytes available to be - * appended from "bytes". If < 0, then all - * bytes up to a NUL byte are available. */ - int limit, /* The maximum number of bytes to append to + Tcl_Size length, /* The number of bytes available to be + * appended from "bytes". If -1, then + * all bytes up to a NUL byte are available. */ + Tcl_Size limit, /* The maximum number of bytes to append to * the object. */ const char *ellipsis) /* Ellipsis marker string, appended to the * object to indicate not all available bytes * at "bytes" were appended. */ { UniCharString *stringPtr; - int toCopy = 0; - int eLen = 0; + Tcl_Size toCopy = 0; + Tcl_Size eLen = 0; if (length < 0) { length = (bytes ? strlen(bytes) : 0); @@ -1672,8 +1664,8 @@ Tcl_AppendToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ - int length) /* The number of bytes to append from "bytes". - * If < 0, then append all bytes up to NUL + Tcl_Size length) /* The number of bytes to append from "bytes". + * If negative, then append all bytes up to NUL * byte. */ { Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL); @@ -1701,7 +1693,8 @@ TclAppendUnicodeToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* The Unicode string to append to the * object. */ - int length) /* Number of chars in unicode. */ + Tcl_Size length) /* Number of chars in Unicode. Negative + * lengths means nul terminated */ { UniCharString *stringPtr; @@ -1735,7 +1728,8 @@ Tcl_AppendUnicodeToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const unsigned short *unicode, /* The unicode string to append to the * object. */ - int length) /* Number of chars in "unicode". */ + Tcl_Size length) /* Number of chars in Unicode. Negative + * lengths means nul terminated */ { String *stringPtr; @@ -1783,7 +1777,8 @@ Tcl_AppendObjToObj( Tcl_Obj *appendObjPtr) /* Object to append. */ { UniCharString *stringPtr; - int length, numChars, appendNumChars = -1; + Tcl_Size length, numChars; + Tcl_Size appendNumChars = TCL_INDEX_NONE; const char *bytes; /* @@ -1823,7 +1818,7 @@ Tcl_AppendObjToObj( * First, get the lengths. */ - int lengthSrc; + Tcl_Size lengthSrc; (void) Tcl_GetByteArrayFromObj(objPtr, &length); (void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc); @@ -1929,10 +1924,10 @@ static void AppendUnicodeToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to append. */ - int appendNumChars) /* Number of chars of "unicode" to append. */ + Tcl_Size appendNumChars) /* Number of chars of "unicode" to append. */ { UniCharString *stringPtr; - int numChars; + Tcl_Size numChars; if (appendNumChars < 0) { appendNumChars = UnicodeLength(unicode); @@ -1956,7 +1951,7 @@ AppendUnicodeToUnicodeRep( uniCharStringCheckLimits(numChars); if (numChars > stringPtr->maxChars) { - int offset = -1; + Tcl_Size offset = TCL_INDEX_NONE; /* * Protect against case where Unicode points into the existing @@ -2018,13 +2013,13 @@ static void AppendUnicodeToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to convert to UTF. */ - int numChars) /* Number of chars of unicode to convert. */ + Tcl_Size numChars) /* Number of chars of Unicode to convert. */ { UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr); numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars); - if (stringPtr->numChars != -1) { + if (stringPtr->numChars != TCL_INDEX_NONE) { stringPtr->numChars += numChars; } } @@ -2051,7 +2046,7 @@ static void AppendUtfToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to convert to Unicode. */ - int numBytes) /* Number of bytes of "bytes" to convert. */ + Tcl_Size numBytes) /* Number of bytes of "bytes" to convert. */ { UniCharString *stringPtr; @@ -2087,10 +2082,10 @@ static void AppendUtfToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to append. */ - int numBytes) /* Number of bytes of "bytes" to append. */ + Tcl_Size numBytes) /* Number of bytes of "bytes" to append. */ { UniCharString *stringPtr; - int newLength, oldLength; + Tcl_Size newLength, oldLength; if (numBytes == 0) { return; @@ -2112,7 +2107,7 @@ AppendUtfToUtfRep( stringPtr = GET_UNICHAR_STRING(objPtr); if (newLength > stringPtr->allocated) { - int offset = -1; + Tcl_Size offset = TCL_INDEX_NONE; /* * Protect against case where unicode points into the existing @@ -2247,12 +2242,12 @@ Tcl_AppendFormatToObj( Tcl_Interp *interp, Tcl_Obj *appendObj, const char *format, - int objc, + Tcl_Size objc, Tcl_Obj *const objv[]) { const char *span = format, *msg, *errCode; - int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; - int originalLength, limit; + int gotXpg = 0, gotSequential = 0; + Tcl_Size objIndex = 0, originalLength, limit, numBytes = 0; Tcl_UniChar ch = 0; static const char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers"; @@ -2275,11 +2270,13 @@ Tcl_AppendFormatToObj( while (*format != '\0') { char *end; int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0; - int width, gotPrecision, precision, sawFlag, useShort = 0, useBig = 0; + int gotPrecision, sawFlag, useShort = 0, useBig = 0; + Tcl_WideInt width, precision; #ifndef TCL_WIDE_INT_IS_LONG int useWide = 0; #endif - int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes; + int newXpg, allocSegment = 0; + Tcl_Size numChars, segmentLimit, segmentNumBytes; Tcl_Obj *segment; int step = TclUtfToUniChar(format, &ch); @@ -2400,7 +2397,7 @@ Tcl_AppendFormatToObj( errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; } - if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[objIndex], &width) != TCL_OK) { goto error; } if (width < 0) { @@ -2437,7 +2434,7 @@ Tcl_AppendFormatToObj( errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; } - if (TclGetIntFromObj(interp, objv[objIndex], &precision) + if (TclGetWideIntFromObj(interp, objv[objIndex], &precision) != TCL_OK) { goto error; } @@ -2558,7 +2555,8 @@ Tcl_AppendFormatToObj( long l; Tcl_WideInt w; mp_int big; - int toAppend, isNegative = 0; + int isNegative = 0; + Tcl_Size toAppend; #ifndef TCL_WIDE_INT_IS_LONG if (ch == 'p') { @@ -2654,7 +2652,7 @@ Tcl_AppendFormatToObj( switch (ch) { case 'd': { - int length; + Tcl_Size length; Tcl_Obj *pure; const char *bytes; @@ -2726,7 +2724,8 @@ Tcl_AppendFormatToObj( case 'b': { Tcl_WideUInt bits = (Tcl_WideUInt) 0; Tcl_WideInt numDigits = (Tcl_WideInt) 0; - int length, numBits = 4, base = 16, index = 0, shift = 0; + int numBits = 4, base = 16, index = 0, shift = 0; + Tcl_Size length; Tcl_Obj *pure; char *bytes; @@ -2887,14 +2886,14 @@ Tcl_AppendFormatToObj( *p++ = '+'; } if (width) { - p += snprintf(p, TCL_INTEGER_SPACE, "%d", width); + p += snprintf(p, TCL_INTEGER_SPACE, "%" TCL_LL_MODIFIER "d", width); if (width > length) { length = width; } } if (gotPrecision) { *p++ = '.'; - p += snprintf(p, TCL_INTEGER_SPACE, "%d", precision); + p += snprintf(p, TCL_INTEGER_SPACE, "%" TCL_LL_MODIFIER "d", precision); if (precision > INT_MAX - length) { msg = overflow; errCode = "OVERFLOW"; @@ -3020,7 +3019,7 @@ Tcl_Obj * Tcl_Format( Tcl_Interp *interp, const char *format, - int objc, + Tcl_Size objc, Tcl_Obj *const objv[]) { int result; @@ -3053,7 +3052,8 @@ AppendPrintfToObjVA( const char *format, va_list argList) { - int code, objc; + int code; + Tcl_Size objc; Tcl_Obj **objv, *list; const char *p; @@ -3334,12 +3334,14 @@ Tcl_Obj * TclStringRepeat( Tcl_Interp *interp, Tcl_Obj *objPtr, - int count, + Tcl_Size count, int flags) { Tcl_Obj *objResultPtr; int inPlace = flags & TCL_STRING_IN_PLACE; - int length = 0, unichar = 0, done = 1; + Tcl_Size length = 0; + int unichar = 0; + Tcl_Size done = 1; int binary = TclIsPureByteArray(objPtr); /* assert (count >= 2) */ @@ -3479,22 +3481,23 @@ TclStringRepeat( Tcl_Obj * TclStringCat( Tcl_Interp *interp, - int objc, + Tcl_Size objc, Tcl_Obj * const objv[], int flags) { Tcl_Obj *objResultPtr, * const *ov; - int oc, length = 0, binary = 1; + int binary = 1; + Tcl_Size oc, length = 0; int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0; - int first = objc - 1; /* Index of first value possibly not empty */ - int last = 0; /* Index of last value possibly not empty */ + 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; /* assert ( objc >= 0 ) */ if (objc <= 1) { - /* Only one or no objects; return first or empty */ - return objc ? objv[0] : Tcl_NewObj(); + /* Negative (shouldn't be), one or no objects; return first or empty */ + return objc == 1 ? objv[0] : Tcl_NewObj(); } /* assert ( objc >= 2 ) */ @@ -3546,7 +3549,7 @@ TclStringCat( * Result will be pure byte array. Pre-size it */ - int numBytes; + Tcl_Size numBytes; ov = objv; oc = objc; do { @@ -3565,7 +3568,8 @@ TclStringCat( last = objc - oc; if (length == 0) { first = last; - } else if (numBytes > INT_MAX - length) { + } + if (length > (INT_MAX-numBytes)) { goto overflow; } length += numBytes; @@ -3583,7 +3587,7 @@ TclStringCat( Tcl_Obj *objPtr = *ov++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - int numChars; + Tcl_Size numChars; TclGetUnicodeFromObj_(objPtr, &numChars); /* PANIC? */ if (numChars) { @@ -3632,7 +3636,7 @@ TclStringCat( first = last = objc - oc - 1; if (oc && (length == 0)) { - int numBytes; + Tcl_Size numBytes; /* assert ( pendingPtr != NULL ) */ @@ -3665,7 +3669,7 @@ TclStringCat( } while (oc && (length == 0)); while (oc) { - int numBytes; + Tcl_Size numBytes; Tcl_Obj *objPtr = *ov++; /* assert ( length > 0 && pendingPtr == NULL ) */ @@ -3700,7 +3704,7 @@ TclStringCat( */ if (inPlace && !Tcl_IsShared(*objv)) { - int start; + Tcl_Size start; objResultPtr = *objv++; objc--; Tcl_GetByteArrayFromObj(objResultPtr, &start); @@ -3719,7 +3723,7 @@ TclStringCat( */ if (TclIsPureByteArray(objPtr)) { - int more; + Tcl_Size more; unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more); memcpy(dst, src, more); dst += more; @@ -3730,7 +3734,7 @@ TclStringCat( Tcl_UniChar *dst; if (inPlace && !Tcl_IsShared(*objv)) { - int start; + Tcl_Size start; objResultPtr = *objv++; objc--; @@ -3770,7 +3774,7 @@ TclStringCat( Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - int more; + Tcl_Size more; Tcl_UniChar *src = TclGetUnicodeFromObj_(objPtr, &more); memcpy(dst, src, more * sizeof(Tcl_UniChar)); dst += more; @@ -3781,7 +3785,7 @@ TclStringCat( char *dst; if (inPlace && !Tcl_IsShared(*objv)) { - int start; + Tcl_Size start; objResultPtr = *objv++; objc--; @@ -3817,7 +3821,7 @@ TclStringCat( Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - int more; + Tcl_Size more; char *src = TclGetStringFromObj(objPtr, &more); memcpy(dst, src, more); @@ -3860,11 +3864,12 @@ TclStringCmp( Tcl_Obj *value2Ptr, int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ - int reqlength) /* requested length in characters; - * TCL_INDEX_NONE to compare whole strings */ + Tcl_Size reqlength) /* requested length in characters; + * negative to compare whole strings */ { const char *s1, *s2; - int empty, length, match, s1len, s2len; + int empty, match; + Tcl_Size length, s1len, s2len; memCmpFn_t memCmpFn; if ((reqlength == 0) || (value1Ptr == value2Ptr)) { @@ -4053,12 +4058,12 @@ Tcl_Obj * TclStringFirst( Tcl_Obj *needle, Tcl_Obj *haystack, - int start) + Tcl_Size start) { int lh, ln = TclGetCharLength(needle); - Tcl_Obj *result; - int value = -1; + Tcl_Size value = TCL_INDEX_NONE; Tcl_UniChar *checkStr, *endStr, *uh, *un; + Tcl_Obj *obj; if (start < 0) { start = 0; @@ -4134,8 +4139,8 @@ TclStringFirst( } } firstEnd: - TclNewIndexObj(result, value); - return result; + TclNewIndexObj(obj, value); + return obj; } /* @@ -4162,10 +4167,10 @@ TclStringLast( Tcl_Obj *haystack, int last) { - int lh, ln = TclGetCharLength(needle); - Tcl_Obj *result; - int value = -1; + Tcl_Size lh, ln = TclGetCharLength(needle); + Tcl_Size value = TCL_INDEX_NONE; Tcl_UniChar *checkStr, *uh, *un; + Tcl_Obj *obj; if (ln == 0) { /* @@ -4221,8 +4226,8 @@ TclStringLast( checkStr--; } lastEnd: - TclNewIndexObj(result, value); - return result; + TclNewIndexObj(obj, value); + return obj; } /* @@ -4247,7 +4252,7 @@ static void ReverseBytes( unsigned char *to, /* Copy bytes into here... */ unsigned char *from, /* ...from here... */ - int count) /* Until this many are copied, */ + Tcl_Size count) /* Until this many are copied, */ /* reversing as you go. */ { unsigned char *src = from + count; @@ -4280,7 +4285,7 @@ TclStringReverse( #endif if (TclIsPureByteArray(objPtr)) { - int numBytes; + Tcl_Size numBytes; unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (!inPlace || Tcl_IsShared(objPtr)) { @@ -4361,8 +4366,8 @@ TclStringReverse( } if (objPtr->bytes) { - int numChars = stringPtr->numChars; - int numBytes = objPtr->length; + Tcl_Size numChars = stringPtr->numChars; + Tcl_Size numBytes = objPtr->length; char *to, *from = objPtr->bytes; if (!inPlace || Tcl_IsShared(objPtr)) { @@ -4381,7 +4386,7 @@ TclStringReverse( * Pass 1. Reverse the bytes of each multi-byte character. */ - int bytesLeft = numBytes; + Tcl_Size bytesLeft = numBytes; int chw; while (bytesLeft) { @@ -4468,7 +4473,7 @@ TclStringReplace( */ if (TclIsPureByteArray(objPtr)) { - int numBytes; + Tcl_Size numBytes; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (insertPtr == NULL) { @@ -4491,7 +4496,7 @@ TclStringReplace( } if (TclIsPureByteArray(insertPtr)) { - int newBytes; + Tcl_Size newBytes; unsigned char *iBytes = Tcl_GetByteArrayFromObj(insertPtr, &newBytes); @@ -4506,7 +4511,7 @@ TclStringReplace( return objPtr; } - if (newBytes > INT_MAX - (numBytes - count)) { + if (newBytes > (INT_MAX - (numBytes - count))) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "max size for a Tcl value (%d bytes) exceeded", @@ -4536,7 +4541,7 @@ TclStringReplace( /* The traditional implementation... */ { - int numChars; + Tcl_Size numChars; Tcl_UniChar *ustring = TclGetUnicodeFromObj_(objPtr, &numChars); /* TODO: Is there an in-place option worth pursuing here? */ @@ -4545,7 +4550,7 @@ TclStringReplace( if (insertPtr) { Tcl_AppendObjToObj(result, insertPtr); } - if (first + count < numChars) { + if ((first + count) < numChars) { TclAppendUnicodeToObj(result, ustring + first + count, numChars - first - count); } @@ -4586,17 +4591,17 @@ static void ExtendUnicodeRepWithString( Tcl_Obj *objPtr, const char *bytes, - int numBytes, - int numAppendChars) + Tcl_Size numBytes, + Tcl_Size numAppendChars) { UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr); - int needed, numOrigChars = 0; + Tcl_Size needed, numOrigChars = 0; Tcl_UniChar *dst, unichar = 0; if (stringPtr->hasUnicode) { numOrigChars = stringPtr->numChars; } - if (numAppendChars == -1) { + if (numAppendChars < 0) { TclNumUtfCharsM(numAppendChars, bytes, numBytes); } needed = numOrigChars + numAppendChars; @@ -4661,7 +4666,7 @@ DupStringInternalRep( UniCharString *srcStringPtr = GET_UNICHAR_STRING(srcPtr); UniCharString *copyStringPtr = NULL; - if (srcStringPtr->numChars == -1) { + if (srcStringPtr->numChars == TCL_INDEX_NONE) { /* * The String struct in the source value holds zero useful data. Don't * bother copying it. Don't even bother allocating space in which to @@ -4720,7 +4725,7 @@ DupStringInternalRep( * * Side effects: * Any old internal representation for objPtr is freed and the internal - * representation is set to "String". + * representation is set to &tclStringType. * *---------------------------------------------------------------------- */ @@ -4797,17 +4802,17 @@ UpdateStringOfString( } } -static int +static Tcl_Size ExtendStringRepWithUnicode( Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - int numChars) + Tcl_Size numChars) { /* * Precondition: this is the "string" Tcl_ObjType. */ - int i, origLength, size = 0; + Tcl_Size i, origLength, size = 0; char *dst; UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr); diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 5a68925..316a945 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -137,7 +137,7 @@ test cmdIL-1.32 {lsort -stride errors} -returnCodes error -body { } -result {expected integer but got "foo"} test cmdIL-1.33 {lsort -stride errors} -returnCodes error -body { lsort -stride 1 bar -} -result {stride length must be at least 2} +} -match glob -result {stride length must be between 2 and *} test cmdIL-1.34 {lsort -stride errors} -returnCodes error -body { lsort -stride 2 {a b c} } -result {list size must be a multiple of the stride length} @@ -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 +} -match glob -result {stride length must be between 2 and *} # 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..c913e60 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.test @@ -552,7 +552,7 @@ test lsearch-23.1 {lsearch -stride option, errors} -body { } -returnCodes error -result {"-stride" option must be followed by stride length} test lsearch-23.2 {lsearch -stride option, errors} -body { lsearch -stride 0 {a b} a -} -returnCodes error -result {stride length must be at least 1} +} -returnCodes error -match glob -result {stride length must be between 1 and *} test lsearch-23.3 {lsearch -stride option, errors} -body { lsearch -stride 2 {a b c} a } -returnCodes error -result {list size must be a multiple of the stride length} @@ -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 -match glob -result {stride length must be between 1 and *} # cleanup -- cgit v0.12 From b58023ffa18027e959e9f2e56118606adfe8343a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 21 Apr 2023 20:32:26 +0000 Subject: Since Tcl_GetSizeIntFromObj is the same as Tcl_GetIntFromObj (in 8.7), it's not worth to spend a stub entry for it --- generic/tcl.decls | 6 ------ generic/tclDecls.h | 12 ++++++------ generic/tclObj.c | 25 ------------------------- generic/tclStubInit.c | 2 +- 4 files changed, 7 insertions(+), 38 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 6ac10cb..daa2f2b 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2567,12 +2567,6 @@ declare 685 { Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr) } -# TIP 660 -declare 686 { - int Tcl_GetSizeIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - Tcl_Size *sizePtr) -} - # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # declare 688 { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 9c3ca0d..d4e4381 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -2049,9 +2049,7 @@ EXTERN int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 685 */ EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr); -/* 686 */ -EXTERN int Tcl_GetSizeIntFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, Tcl_Size *sizePtr); +/* Slot 686 is reserved */ /* Slot 687 is reserved */ /* 688 */ EXTERN void TclUnusedStubEntry(void); @@ -2776,7 +2774,7 @@ typedef struct TclStubs { Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */ Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */ - int (*tcl_GetSizeIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *sizePtr); /* 686 */ + void (*reserved686)(void); void (*reserved687)(void); void (*tclUnusedStubEntry) (void); /* 688 */ } TclStubs; @@ -4181,8 +4179,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetWideUIntFromObj) /* 684 */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 685 */ -#define Tcl_GetSizeIntFromObj \ - (tclStubsPtr->tcl_GetSizeIntFromObj) /* 686 */ +/* Slot 686 is reserved */ /* Slot 687 is reserved */ #define TclUnusedStubEntry \ (tclStubsPtr->tclUnusedStubEntry) /* 688 */ @@ -4586,4 +4583,7 @@ extern const TclStubs *tclStubsPtr; #define Tcl_GetSlave Tcl_GetChild #define Tcl_GetMaster Tcl_GetParent +/* TIP #660 */ +#define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj + #endif /* _TCLDECLS */ diff --git a/generic/tclObj.c b/generic/tclObj.c index 93e3a08..94cf376 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3551,31 +3551,6 @@ TclGetWideBitsFromObj( /* *---------------------------------------------------------------------- * - * Tcl_GetSizeIntFromObj -- - * - * Attempt to return a Tcl_Size from the Tcl object "objPtr". - * - * Results: - * TCL_OK - the converted Tcl_Size value is stored in *sizePtr - * TCL_ERROR - the error message is stored in interp - * - * Side effects: - * The function may free up any existing internal representation. - * - *---------------------------------------------------------------------- - */ -int -Tcl_GetSizeIntFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* The object from which to get a int. */ - Tcl_Size *sizePtr) /* Place to store resulting int. */ -{ - return Tcl_GetIntFromObj(interp, objPtr, sizePtr); -} - -/* - *---------------------------------------------------------------------- - * * FreeBignum -- * * This function frees the internal rep of a bignum. diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 104375e..e09d74d 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -2057,7 +2057,7 @@ const TclStubs tclStubs = { Tcl_GetEncodingNulLength, /* 683 */ Tcl_GetWideUIntFromObj, /* 684 */ Tcl_DStringToObj, /* 685 */ - Tcl_GetSizeIntFromObj, /* 686 */ + 0, /* 686 */ 0, /* 687 */ TclUnusedStubEntry, /* 688 */ }; -- cgit v0.12 From a3380d8151e2791d70300455b60e8a6a73948c0c Mon Sep 17 00:00:00 2001 From: pooryorick Date: Fri, 21 Apr 2023 20:32:38 +0000 Subject: Make Tcl_AppendObjToObj more efficient and avoid unnecessarily generating a string representation when the object to append to is the empty string. --- doc/StringObj.3 | 2 +- generic/tclStringObj.c | 61 +++++++++++++++++++++++--------------------------- 2 files changed, 29 insertions(+), 34 deletions(-) diff --git a/doc/StringObj.3 b/doc/StringObj.3 index d835140..b708298 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 diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 2bbc4bc..48344d7 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -551,9 +551,8 @@ TclCheckEmptyString( int Tcl_GetUniChar( - Tcl_Obj *objPtr, /* The object to get the Unicode charater - * from. */ - Tcl_Size index) /* Get the index'th Unicode character. */ + Tcl_Obj *objPtr, /* The object to get the Unicode character from. */ + Tcl_Size index) /* Get the index'th Unicode character. */ { String *stringPtr; int ch; @@ -563,8 +562,8 @@ Tcl_GetUniChar( } /* - * Optimize the case where we're really dealing with a ByteArray object - * we don't need to convert to a string to perform the indexing operation. + * For a ByteArray object there is no need to convert to a string to + * perform the indexing operation. */ if (TclIsPureByteArray(objPtr)) { @@ -578,7 +577,7 @@ Tcl_GetUniChar( } /* - * OK, need to work with the object as a string. + * Must work with the object as a string. */ SetStringFromAny(NULL, objPtr); @@ -624,9 +623,8 @@ Tcl_GetUniChar( int TclGetUniChar( - Tcl_Obj *objPtr, /* The object to get the Unicode charater - * from. */ - Tcl_Size index) /* Get the index'th Unicode character. */ + Tcl_Obj *objPtr, /* The object to get the Unicode character from. */ + Tcl_Size index) /* Get the index'th Unicode character. */ { int ch = 0; @@ -1405,17 +1403,13 @@ Tcl_AppendUnicodeToObj( *---------------------------------------------------------------------- * * Tcl_AppendObjToObj -- - * - * This function appends the string rep of one object to another. - * "objPtr" cannot be a shared object. + * Appends the value of apppendObjPtr to objPtr, which must not be shared. * * Results: * None. * * Side effects: - * The string rep of appendObjPtr is appended to the string - * representation of objPtr. - * IMPORTANT: This routine does not and MUST NOT shimmer appendObjPtr. + * IMPORTANT: Does not and MUST NOT shimmer appendObjPtr. * Callers are counting on that. * *---------------------------------------------------------------------- @@ -1423,34 +1417,35 @@ Tcl_AppendUnicodeToObj( void Tcl_AppendObjToObj( - Tcl_Obj *objPtr, /* Points to the object to append to. */ - Tcl_Obj *appendObjPtr) /* Object to append. */ + Tcl_Obj *objPtr, /* Points to the value to append to. */ + Tcl_Obj *appendObjPtr) /* The value to append. */ { String *stringPtr; Tcl_Size length = 0, numChars; 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 (appendObjPtr->bytes == &tclEmptyString) { 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 (objPtr->bytes == &tclEmptyString) { + TclSetDuplicateObj(objPtr, appendObjPtr); + return; + } + + if ( + TclIsPureByteArray(appendObjPtr) + && (TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString) + ) { + /* + * Both bytearray objects are pure. Therefore they faithfully + * represent the true values, making it safe to append the second + * bytearray to the first. + */ - 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); @@ -3375,7 +3370,7 @@ TclStringCat( objResultPtr = *objv++; objc--; - /* Ugly interface! Force resize of the unicode array. */ + /* Ugly interface! Force resize of the Unicode array. */ (void)Tcl_GetUnicodeFromObj(objResultPtr, &start); Tcl_InvalidateStringRep(objResultPtr); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { @@ -4214,7 +4209,7 @@ TclStringReplace( static void FillUnicodeRep( - Tcl_Obj *objPtr) /* The object in which to fill the unicode + Tcl_Obj *objPtr) /* The object in which to fill the Unicode * rep. */ { String *stringPtr = GET_STRING(objPtr); -- cgit v0.12 From 4402cae44685a3ca1b3c0c4bf9c5d0680195a0e8 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Sat, 22 Apr 2023 10:04:53 +0000 Subject: Use TclListObjRange in lassign for performance reasons --- generic/tclCmdIL.c | 17 +++++++++++++++-- generic/tclExecute.c | 10 +++++----- generic/tclInt.h | 4 ++-- generic/tclListObj.c | 3 ++- 4 files changed, 24 insertions(+), 10 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index f6d3df3..383cec4 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; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 7f431bd..e3b85b4 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5154,12 +5154,12 @@ TEBCresume( if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) { 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/tclInt.h b/generic/tclInt.h index c073f42..1481b5c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3249,8 +3249,8 @@ MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); MODULE_SCOPE int TclListObjAppendElements(Tcl_Interp *interp, Tcl_Obj *toObj, int elemCount, Tcl_Obj *const elemObjv[]); -MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Obj *listPtr, int fromIdx, - int toIdx); +MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Interp *interp, Tcl_Obj *listPtr, + int fromIdx, int 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, diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 811bd0f..a850695 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1602,6 +1602,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. */ @@ -1610,7 +1611,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); -- cgit v0.12 From 39180cad0ef18a8bda37c082bac7bd3297bc9345 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 22 Apr 2023 16:29:07 +0000 Subject: Backout [4a7b807856], It breaks the build. See: [https://github.com/tcltk/tcl/actions/runs/4771586851/jobs/8483606969] --- doc/StringObj.3 | 2 +- generic/tclStringObj.c | 61 +++++++++++++++++++++++++++----------------------- 2 files changed, 34 insertions(+), 29 deletions(-) diff --git a/doc/StringObj.3 b/doc/StringObj.3 index b708298..d835140 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 -A pointer to a value to read, or to an unshared value to modify. +Points to a value to manipulate. .AP Tcl_Obj *appendObjPtr in The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR. .AP "Tcl_Size \&| int" *lengthPtr out diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 48344d7..2bbc4bc 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -551,8 +551,9 @@ TclCheckEmptyString( int Tcl_GetUniChar( - Tcl_Obj *objPtr, /* The object to get the Unicode character from. */ - Tcl_Size index) /* Get the index'th Unicode character. */ + Tcl_Obj *objPtr, /* The object to get the Unicode charater + * from. */ + Tcl_Size index) /* Get the index'th Unicode character. */ { String *stringPtr; int ch; @@ -562,8 +563,8 @@ Tcl_GetUniChar( } /* - * For a ByteArray object there is no need to convert to a string to - * perform the indexing operation. + * Optimize the case where we're really dealing with a ByteArray object + * we don't need to convert to a string to perform the indexing operation. */ if (TclIsPureByteArray(objPtr)) { @@ -577,7 +578,7 @@ Tcl_GetUniChar( } /* - * Must work with the object as a string. + * OK, need to work with the object as a string. */ SetStringFromAny(NULL, objPtr); @@ -623,8 +624,9 @@ Tcl_GetUniChar( int TclGetUniChar( - Tcl_Obj *objPtr, /* The object to get the Unicode character from. */ - Tcl_Size index) /* Get the index'th Unicode character. */ + Tcl_Obj *objPtr, /* The object to get the Unicode charater + * from. */ + Tcl_Size index) /* Get the index'th Unicode character. */ { int ch = 0; @@ -1403,13 +1405,17 @@ Tcl_AppendUnicodeToObj( *---------------------------------------------------------------------- * * Tcl_AppendObjToObj -- - * Appends the value of apppendObjPtr to objPtr, which must not be shared. + * + * This function appends the string rep of one object to another. + * "objPtr" cannot be a shared object. * * Results: * None. * * Side effects: - * IMPORTANT: Does not and MUST NOT shimmer appendObjPtr. + * The string rep of appendObjPtr is appended to the string + * representation of objPtr. + * IMPORTANT: This routine does not and MUST NOT shimmer appendObjPtr. * Callers are counting on that. * *---------------------------------------------------------------------- @@ -1417,35 +1423,34 @@ Tcl_AppendUnicodeToObj( void Tcl_AppendObjToObj( - Tcl_Obj *objPtr, /* Points to the value to append to. */ - Tcl_Obj *appendObjPtr) /* The value to append. */ + Tcl_Obj *objPtr, /* Points to the object to append to. */ + Tcl_Obj *appendObjPtr) /* Object to append. */ { String *stringPtr; Tcl_Size length = 0, numChars; Tcl_Size appendNumChars = TCL_INDEX_NONE; const char *bytes; - if (appendObjPtr->bytes == &tclEmptyString) { - return; - } + /* + * Special case: second object is standard-empty is fast case. We know + * that appending nothing to anything leaves that starting anything... + */ - if (objPtr->bytes == &tclEmptyString) { - TclSetDuplicateObj(objPtr, appendObjPtr); + if (appendObjPtr->bytes == &tclEmptyString) { return; } - if ( - TclIsPureByteArray(appendObjPtr) - && (TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString) - ) { - /* - * Both bytearray objects are pure. Therefore they faithfully - * represent the true values, making it safe to append the second - * bytearray to the first. - */ + /* + * 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(objPtr) || objPtr->bytes == &tclEmptyString) + && TclIsPureByteArray(appendObjPtr)) { /* - * One might expect the code here to be + * You might expect the code here to be * * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length); * TclAppendBytesToByteArray(objPtr, bytes, length); @@ -3370,7 +3375,7 @@ TclStringCat( objResultPtr = *objv++; objc--; - /* Ugly interface! Force resize of the Unicode array. */ + /* Ugly interface! Force resize of the unicode array. */ (void)Tcl_GetUnicodeFromObj(objResultPtr, &start); Tcl_InvalidateStringRep(objResultPtr); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { @@ -4209,7 +4214,7 @@ TclStringReplace( static void FillUnicodeRep( - Tcl_Obj *objPtr) /* The object in which to fill the Unicode + Tcl_Obj *objPtr) /* The object in which to fill the unicode * rep. */ { String *stringPtr = GET_STRING(objPtr); -- cgit v0.12 From 556c3fc35b1011e4ed012fafa8e3907ad45752e2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 22 Apr 2023 16:34:56 +0000 Subject: Fix [2a5cb49733ff]: Make TCL_NO_TOMMATH_H sufficient for tclTomMathDecls.h --- generic/tclTomMath.h | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h index 40a4e9d..1d4f30a 100644 --- a/generic/tclTomMath.h +++ b/generic/tclTomMath.h @@ -24,6 +24,15 @@ # 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 + #endif + define MP_DEPRECATED_PRAGMA(s) /* nothing */ # define MP_WUR /* nothing */ # define mp_iszero(a) ((a)->used == 0) # define mp_isneg(a) ((a)->sign != 0) -- cgit v0.12 From 9ec33349d58033ef07bfbbdeb48d2939a9ffb5a9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 22 Apr 2023 17:29:49 +0000 Subject: Fix tclTomMath.h (from prev commit) --- generic/tclTomMath.h | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h index 1d4f30a..26db082 100644 --- a/generic/tclTomMath.h +++ b/generic/tclTomMath.h @@ -25,14 +25,13 @@ # 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 +# 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 - #endif - define MP_DEPRECATED_PRAGMA(s) /* nothing */ +# 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) -- cgit v0.12 From 8da10bea0f8c1888cd8ed0bb3097826efbf37f81 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 22 Apr 2023 17:31:50 +0000 Subject: Register "utf32string" for Python --- generic/tclObj.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/generic/tclObj.c b/generic/tclObj.c index 94cf376..829e046 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -390,6 +390,10 @@ TclInitObjSubsystem(void) #if (TCL_UTF_MAX < 4) || !defined(TCL_NO_DEPRECATED) Tcl_RegisterObjType(&tclStringType); #endif +#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED) + /* Only registered for 8.7, not for 9.0 any more. See [] */ + Tcl_RegisterObjType(&tclUniCharStringType); +#endif Tcl_RegisterObjType(&tclListType); Tcl_RegisterObjType(&tclDictType); Tcl_RegisterObjType(&tclByteCodeType); -- cgit v0.12 From c90b84b1166c26f2d17506cb3c39ead08e7e9d34 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 22 Apr 2023 17:32:52 +0000 Subject: Fill in URL in previous commit --- generic/tclObj.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index 829e046..7c433d1 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -391,7 +391,8 @@ TclInitObjSubsystem(void) Tcl_RegisterObjType(&tclStringType); #endif #if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED) - /* Only registered for 8.7, not for 9.0 any more. See [] */ + /* Only registered for 8.7, not for 9.0 any more. + * See [https://core.tcl-lang.org/tk/tktview/6b49149b4e] */ Tcl_RegisterObjType(&tclUniCharStringType); #endif Tcl_RegisterObjType(&tclListType); -- cgit v0.12 From f14ee8d1bb0f076e919df01cbdd9059e1e5b9a93 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 22 Apr 2023 17:55:36 +0000 Subject: Fix [203792a48c]: Avoid signed integer overflow in Utf32ToUtfProc() --- generic/tclEncoding.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 774485d..647ed68 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2774,9 +2774,9 @@ Utf32ToUtfProc( int prev = ch; 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 (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) { /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */ -- cgit v0.12 From 08d2d4c09be5b73ac1afa73c49d4cad5aff59cf2 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sat, 22 Apr 2023 22:49:50 +0000 Subject: Make Tcl_AppendObjToObj avoid string generation in a couple more circumstances, and edit some documentation and comments. --- generic/tclStringObj.c | 68 ++++++++++++++++++++++++++------------------------ 1 file changed, 36 insertions(+), 32 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 2bbc4bc..1507a99 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -551,9 +551,8 @@ TclCheckEmptyString( int Tcl_GetUniChar( - Tcl_Obj *objPtr, /* The object to get the Unicode charater - * from. */ - Tcl_Size index) /* Get the index'th Unicode character. */ + Tcl_Obj *objPtr, /* The object to get the Unicode character from. */ + Tcl_Size index) /* The index of the Unicode character to retrieve. */ { String *stringPtr; int ch; @@ -563,8 +562,8 @@ Tcl_GetUniChar( } /* - * Optimize the case where we're really dealing with a ByteArray object - * we don't need to convert to a string to perform the indexing operation. + * For a ByteArray object there is no need to convert to a string to + * perform the indexing operation. */ if (TclIsPureByteArray(objPtr)) { @@ -578,7 +577,7 @@ Tcl_GetUniChar( } /* - * OK, need to work with the object as a string. + * Must work with the object as a string. */ SetStringFromAny(NULL, objPtr); @@ -624,9 +623,8 @@ Tcl_GetUniChar( int TclGetUniChar( - Tcl_Obj *objPtr, /* The object to get the Unicode charater - * from. */ - Tcl_Size index) /* Get the index'th Unicode character. */ + Tcl_Obj *objPtr, /* The object to get the Unicode character from. */ + Tcl_Size index) /* The index of the Unicode character to retrieve. */ { int ch = 0; @@ -1405,52 +1403,58 @@ Tcl_AppendUnicodeToObj( *---------------------------------------------------------------------- * * Tcl_AppendObjToObj -- - * - * This function appends the string rep of one object to another. - * "objPtr" cannot be a shared object. + * Appends the value of appendObjPtr to objPtr, which must not be shared. * * Results: * None. * * Side effects: - * The string rep of appendObjPtr is appended to the string - * representation of objPtr. - * IMPORTANT: This routine does not and MUST NOT shimmer appendObjPtr. - * Callers are counting on that. + * IMPORTANT: Does not and MUST NOT shimmer appendObjPtr. * *---------------------------------------------------------------------- */ void Tcl_AppendObjToObj( - Tcl_Obj *objPtr, /* Points to the object to append to. */ - Tcl_Obj *appendObjPtr) /* Object to append. */ + Tcl_Obj *objPtr, /* Points to the value to append to. */ + Tcl_Obj *appendObjPtr) /* The value to append. */ { String *stringPtr; Tcl_Size length = 0, numChars; 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 (appendObjPtr->bytes == &tclEmptyString + || (( + TclIsPureByteArray(appendObjPtr) + && Tcl_GetCharLength(appendObjPtr) == 0) + ) + ) { + return; + } - if (appendObjPtr->bytes == &tclEmptyString) { + if (objPtr->bytes == &tclEmptyString + || ( + TclIsPureByteArray(objPtr) + && Tcl_GetCharLength(objPtr) == 0 + ) + ) { + 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. Therefore they faithfully + * represent the true values, making it safe to append the second + * bytearray to the first. + */ - 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); -- cgit v0.12