ag/cpython-source-deps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Import Tcl 8.6.11

Browse Source
This commit is contained in:
Steve Dower
2021-03-30 00:51:39 +01:00
parent 3bb8e3e086
commit 1aadb2455c
923 changed files with 79104 additions and 62616 deletions
Download Patch File Download Diff File Expand all files Collapse all files

302
generic/tclStringObj.c
View File

@@ -149,9 +149,9 @@ GrowStringBuffer(
objPtr->bytes = NULL;
}
if (flag == 0 || stringPtr->allocated > 0) {
attempt = 2 * needed;
if (attempt >= 0) {
ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
if (needed <= INT_MAX / 2) {
attempt = 2 * needed;
ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1);
}
if (ptr == NULL) {
/*
@@ -164,7 +164,7 @@ GrowStringBuffer(
int growth = (int) ((extra > limit) ? limit : extra);
attempt = needed + growth;
ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1);
}
}
if (ptr == NULL) {
@@ -173,7 +173,7 @@ GrowStringBuffer(
*/
attempt = needed;
ptr = ckrealloc(objPtr->bytes, attempt + 1);
ptr = (char *)ckrealloc(objPtr->bytes, attempt + 1);
}
objPtr->bytes = ptr;
stringPtr->allocated = attempt;
@@ -199,8 +199,8 @@ GrowUnicodeBuffer(
* Subsequent appends - apply the growth algorithm.
*/
attempt = 2 * needed;
if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
if (needed <= STRING_MAXCHARS / 2) {
attempt = 2 * needed;
ptr = stringAttemptRealloc(stringPtr, attempt);
}
if (ptr == NULL) {
@@ -417,6 +417,15 @@ Tcl_GetCharLength(
String *stringPtr;
int numChars;
/*
* Quick, no-shimmer return for short string reps.
*/
if ((objPtr->bytes) && (objPtr->length < 2)) {
/* 0 bytes -> 0 chars; 1 byte -> 1 char */
return objPtr->length;
}
/*
* Optimize the case where we're really dealing with a bytearray object;
* we don't need to convert to a string to perform the get-length operation.
@@ -434,7 +443,6 @@ Tcl_GetCharLength(
return length;
}
/*
* OK, need to work with the object as a string.
*/
@@ -465,8 +473,6 @@ Tcl_GetCharLength(
}
return numChars;
}
/*
*----------------------------------------------------------------------
@@ -486,8 +492,8 @@ Tcl_GetCharLength(
*/
int
TclCheckEmptyString (
Tcl_Obj *objPtr
) {
Tcl_Obj *objPtr)
{
int length = -1;
if (objPtr->bytes == tclEmptyStringRep) {
@@ -513,10 +519,10 @@ TclCheckEmptyString (
/*
*----------------------------------------------------------------------
*
* Tcl_GetUniChar --
* Tcl_GetUniChar/TclGetUCS4 --
*
* Get the index'th Unicode character from the String object. The index
* is assumed to be in the appropriate range.
* Get the index'th Unicode character from the String object. If index
* is out of range, the result = 0xFFFD (Tcl_GetUniChar) resp. -1 (TclGetUCS4)
*
* Results:
* Returns the index'th Unicode character in the Object.
@@ -534,15 +540,22 @@ Tcl_GetUniChar(
int index) /* Get the index'th Unicode character. */
{
String *stringPtr;
int length;
if (index < 0) {
return 0xFFFD;
}
/*
* Optimize the case where we're really dealing with a bytearray object
* without string representation; we don't need to convert to a string to
* perform the indexing operation.
* we don't need to convert to a string to perform the indexing operation.
*/
if (TclIsPureByteArray(objPtr)) {
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
if (index >= length) {
return 0xFFFD;
}
return (Tcl_UniChar) bytes[index];
}
@@ -568,8 +581,86 @@ Tcl_GetUniChar(
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (index >= stringPtr->numChars) {
return 0xFFFD;
}
return stringPtr->unicode[index];
}
#if TCL_UTF_MAX == 4
int
TclGetUCS4(
Tcl_Obj *objPtr, /* The object to get the Unicode charater
* from. */
int index) /* Get the index'th Unicode character. */
{
String *stringPtr;
int ch, length;
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.
*/
if (TclIsPureByteArray(objPtr)) {
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
if (index >= length) {
return -1;
}
return (int) bytes[index];
}
/*
* OK, need to work with the object as a string.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
/*
* If numChars is unknown, compute it.
*/
if (stringPtr->numChars == -1) {
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
return (Tcl_UniChar) objPtr->bytes[index];
}
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (index >= stringPtr->numChars) {
return -1;
}
ch = stringPtr->unicode[index];
#if TCL_UTF_MAX <= 4
/* See: bug [11ae2be95dac9417] */
if ((ch & 0xF800) == 0xD800) {
if (ch & 0x400) {
if ((index > 0)
&& ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) {
ch = -1; /* low surrogate preceded by high surrogate */
}
} else if ((++index < stringPtr->numChars)
&& ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) {
/* high surrogate followed by low surrogate */
ch = (((ch & 0x3FF) << 10) |
(stringPtr->unicode[index] & 0x3FF)) + 0x10000;
}
}
#endif
return ch;
}
#endif
/*
*----------------------------------------------------------------------
@@ -668,17 +759,27 @@ Tcl_GetRange(
{
Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
String *stringPtr;
int length;
if (first < 0) {
first = 0;
}
/*
* Optimize the case where we're really dealing with a bytearray object
* without string representation; we don't need to convert to a string to
* perform the substring operation.
* we don't need to convert to a string to perform the substring operation.
*/
if (TclIsPureByteArray(objPtr)) {
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
return Tcl_NewByteArrayObj(bytes+first, last-first+1);
if (last >= length) {
last = length - 1;
}
if (last < first) {
return Tcl_NewObj();
}
return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
}
/*
@@ -697,6 +798,12 @@ Tcl_GetRange(
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
if (last >= stringPtr->numChars) {
last = stringPtr->numChars - 1;
}
if (last < first) {
return Tcl_NewObj();
}
newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
/*
@@ -711,19 +818,25 @@ Tcl_GetRange(
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (last > stringPtr->numChars) {
last = stringPtr->numChars;
}
if (last < first) {
return Tcl_NewObj();
}
#if TCL_UTF_MAX == 4
/* See: bug [11ae2be95dac9417] */
if ((first>0) && ((stringPtr->unicode[first]&0xFC00) == 0xDC00)
&& ((stringPtr->unicode[first-1]&0xFC00) == 0xD800)) {
++first;
}
if ((last+1<stringPtr->numChars) && ((stringPtr->unicode[last+1]&0xFC00) == 0xDC00)
&& ((stringPtr->unicode[last]&0xFC00) == 0xD800)) {
++last;
}
/* See: bug [11ae2be95dac9417] */
if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
&& ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
++first;
}
if ((last + 1 < stringPtr->numChars)
&& ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
&& ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
++last;
}
#endif
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}
/*
@@ -840,9 +953,9 @@ Tcl_SetObjLength(
* Need to enlarge the buffer.
*/
if (objPtr->bytes == tclEmptyStringRep) {
objPtr->bytes = ckalloc(length + 1);
objPtr->bytes = (char *)ckalloc(length + 1);
} else {
objPtr->bytes = ckrealloc(objPtr->bytes, length + 1);
objPtr->bytes = (char *)ckrealloc(objPtr->bytes, length + 1);
}
stringPtr->allocated = length;
}
@@ -946,9 +1059,9 @@ Tcl_AttemptSetObjLength(
char *newBytes;
if (objPtr->bytes == tclEmptyStringRep) {
newBytes = attemptckalloc(length + 1);
newBytes = (char *)attemptckalloc(length + 1);
} else {
newBytes = attemptckrealloc(objPtr->bytes, length + 1);
newBytes = (char *)attemptckrealloc(objPtr->bytes, length + 1);
}
if (newBytes == NULL) {
return 0;
@@ -1112,10 +1225,7 @@ Tcl_AppendLimitedToObj(
{
String *stringPtr;
int toCopy = 0;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
}
int eLen = 0;
if (length < 0) {
length = (bytes ? strlen(bytes) : 0);
@@ -1123,6 +1233,9 @@ Tcl_AppendLimitedToObj(
if (length == 0) {
return;
}
if (limit <= 0) {
return;
}
if (length <= limit) {
toCopy = length;
@@ -1130,8 +1243,12 @@ Tcl_AppendLimitedToObj(
if (ellipsis == NULL) {
ellipsis = "...";
}
toCopy = (bytes == NULL) ? limit
: Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes;
eLen = strlen(ellipsis);
while (eLen > limit) {
eLen = TclUtfPrev(ellipsis+eLen, ellipsis) - ellipsis;
}
toCopy = TclUtfPrev(bytes+limit+1-eLen, bytes) - bytes;
}
/*
@@ -1140,6 +1257,10 @@ Tcl_AppendLimitedToObj(
* objPtr's string rep.
*/
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
@@ -1155,9 +1276,9 @@ Tcl_AppendLimitedToObj(
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis));
AppendUtfToUnicodeRep(objPtr, ellipsis, eLen);
} else {
AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis));
AppendUtfToUtfRep(objPtr, ellipsis, eLen);
}
}
@@ -1291,39 +1412,45 @@ Tcl_AppendObjToObj(
if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
&& TclIsPureByteArray(appendObjPtr)) {
/*
* You might expect the code here to be
*
* bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
* TclAppendBytesToByteArray(objPtr, bytes, length);
*
* and essentially all of the time that would be fine. However,
* it would run into trouble in the case where objPtr and
* appendObjPtr point to the same thing. That may never be a
* good idea. It seems to violate Copy On Write, and we don't
* have any tests for the situation, since making any Tcl commands
* that call Tcl_AppendObjToObj() do that appears impossible
* (They honor Copy On Write!). For the sake of extensions that
* go off into that realm, though, here's a more complex approach
* that can handle all the cases.
* and essentially all of the time that would be fine. However, it
* would run into trouble in the case where objPtr and appendObjPtr
* point to the same thing. That may never be a good idea. It seems to
* violate Copy On Write, and we don't have any tests for the
* situation, since making any Tcl commands that call
* Tcl_AppendObjToObj() do that appears impossible (They honor Copy On
* Write!). For the sake of extensions that go off into that realm,
* though, here's a more complex approach that can handle all the
* cases.
*
* First, get the lengths.
*/
/* Get lengths */
int lengthSrc;
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
/* Grow buffer enough for the append */
/*
* Grow buffer enough for the append.
*/
TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
/* Reset objPtr back to the original value */
/*
* Reset objPtr back to the original value.
*/
Tcl_SetByteArrayLength(objPtr, length);
/*
* Now do the append knowing that buffer growth cannot cause
* any trouble.
* Now do the append knowing that buffer growth cannot cause any
* trouble.
*/
TclAppendBytesToByteArray(objPtr,
@@ -1375,6 +1502,7 @@ Tcl_AppendObjToObj(
numChars = stringPtr->numChars;
if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
String *appendStringPtr = GET_STRING(appendObjPtr);
appendNumChars = appendStringPtr->numChars;
}
@@ -1994,7 +2122,7 @@ Tcl_AppendFormatToObj(
}
break;
case 'c': {
char buf[TCL_UTF_MAX];
char buf[4] = "";
int code, length;
if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) {
@@ -2081,7 +2209,7 @@ Tcl_AppendFormatToObj(
isNegative = (l < (long) 0);
}
segment = Tcl_NewObj();
TclNewObj(segment);
allocSegment = 1;
segmentLimit = INT_MAX;
Tcl_IncrRefCount(segment);
@@ -2121,7 +2249,7 @@ Tcl_AppendFormatToObj(
const char *bytes;
if (useShort) {
pure = Tcl_NewIntObj((int) s);
TclNewIntObj(pure, (int) s);
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
pure = Tcl_NewWideIntObj(w);
@@ -2250,7 +2378,7 @@ Tcl_AppendFormatToObj(
if ((numDigits == 0) && !((ch == 'o') && gotHash)) {
numDigits = 1;
}
pure = Tcl_NewObj();
TclNewObj(pure);
Tcl_SetObjLength(pure, (int) numDigits);
bytes = TclGetString(pure);
toAppend = length = (int) numDigits;
@@ -2369,7 +2497,7 @@ Tcl_AppendFormatToObj(
*p++ = (char) ch;
*p = '\0';
segment = Tcl_NewObj();
TclNewObj(segment);
allocSegment = 1;
if (!Tcl_AttemptSetObjLength(segment, length)) {
msg = overflow;
@@ -2458,7 +2586,7 @@ Tcl_AppendFormatToObj(
/*
*---------------------------------------------------------------------------
*
* Tcl_Format--
* Tcl_Format --
*
* Results:
* A refcount zero Tcl_Obj.
@@ -2477,8 +2605,9 @@ Tcl_Format(
Tcl_Obj *const objv[])
{
int result;
Tcl_Obj *objPtr = Tcl_NewObj();
Tcl_Obj *objPtr;
TclNewObj(objPtr);
result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
if (result != TCL_OK) {
Tcl_DecrRefCount(objPtr);
@@ -2506,9 +2635,10 @@ AppendPrintfToObjVA(
va_list argList)
{
int code, objc;
Tcl_Obj **objv, *list = Tcl_NewObj();
Tcl_Obj **objv, *list;
const char *p;
TclNewObj(list);
p = format;
Tcl_IncrRefCount(list);
while (*p != '\0') {
@@ -2548,7 +2678,7 @@ AppendPrintfToObjVA(
* multi-byte characters.
*/
q = Tcl_UtfPrev(end, bytes);
q = TclUtfPrev(end, bytes);
if (!Tcl_UtfCharComplete(q, (int)(end - q))) {
end = q;
}
@@ -2680,8 +2810,9 @@ Tcl_ObjPrintf(
...)
{
va_list argList;
Tcl_Obj *objPtr = Tcl_NewObj();
Tcl_Obj *objPtr;
TclNewObj(objPtr);
va_start(argList, format);
AppendPrintfToObjVA(objPtr, format, argList);
va_end(argList);
@@ -2723,7 +2854,7 @@ TclGetStringStorage(
/*
*---------------------------------------------------------------------------
*
* TclStringObjReverse --
* TclStringReverse --
*
* Implements the [string reverse] operation.
*
@@ -2742,18 +2873,20 @@ static void
ReverseBytes(
unsigned char *to, /* Copy bytes into here... */
unsigned char *from, /* ...from here... */
int count) /* Until this many are copied, */
int count) /* Until this many are copied, */
/* reversing as you go. */
{
unsigned char *src = from + count;
if (to == from) {
/* Reversing in place */
while (--src > to) {
unsigned char c = *src;
*src = *to;
*to++ = c;
}
} else {
} else {
while (--src >= from) {
*to++ = *src;
}
@@ -2761,7 +2894,7 @@ ReverseBytes(
}
Tcl_Obj *
TclStringObjReverse(
TclStringReverse(
Tcl_Obj *objPtr)
{
String *stringPtr;
@@ -2800,7 +2933,10 @@ TclStringObjReverse(
*to++ = *src;
}
} else {
/* Reversing in place */
/*
* Reversing in place.
*/
while (--src > from) {
ch = *src;
*src = *from;
@@ -2815,7 +2951,7 @@ TclStringObjReverse(
char *to, *from = objPtr->bytes;
if (Tcl_IsShared(objPtr)) {
objPtr = Tcl_NewObj();
TclNewObj(objPtr);
Tcl_SetObjLength(objPtr, numBytes);
}
to = objPtr->bytes;
@@ -2824,20 +2960,22 @@ TclStringObjReverse(
/*
* Either numChars == -1 and we don't know how many chars are
* represented by objPtr->bytes and we need Pass 1 just in case,
* or numChars >= 0 and we know we have fewer chars than bytes,
* so we know there's a multibyte character needing Pass 1.
* or numChars >= 0 and we know we have fewer chars than bytes, so
* we know there's a multibyte character needing Pass 1.
*
* Pass 1. Reverse the bytes of each multi-byte character.
*/
int charCount = 0;
int bytesLeft = numBytes;
while (bytesLeft) {
/*
* NOTE: We know that the from buffer is NUL-terminated.
* It's part of the contract for objPtr->bytes values.
* Thus, we can skip calling Tcl_UtfCharComplete() here.
* NOTE: We know that the from buffer is NUL-terminated. It's
* part of the contract for objPtr->bytes values. Thus, we can
* skip calling Tcl_UtfCharComplete() here.
*/
int bytesInChar = TclUtfToUniChar(from, &ch);
ReverseBytes((unsigned char *)to, (unsigned char *)from,
@@ -3135,7 +3273,7 @@ ExtendStringRepWithUnicode(
*/
int i, origLength, size = 0;
char *dst, buf[TCL_UTF_MAX];
char *dst, buf[4] = "";
String *stringPtr = GET_STRING(objPtr);
if (numChars < 0) {