Import Tcl-code 8.6.8

This commit is contained in:
Cheryl Sabella
2018-02-22 14:28:00 -05:00
parent 261a0e7c44
commit cc7c413b4f
509 changed files with 18473 additions and 18499 deletions

View File

@@ -418,12 +418,16 @@ Tcl_GetCharLength(
int numChars;
/*
* 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 get-length 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 get-length operation.
*
* NOTE that we do not need the bytearray to be "pure". A ByteArray value
* with a string rep cannot be trusted to represent the same value as the
* string rep, but it *can* be trusted to have the same character length
* as the string rep, which is all this routine cares about.
*/
if (TclIsPureByteArray(objPtr)) {
if (objPtr->typePtr == &tclByteArrayType) {
int length;
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
@@ -1198,6 +1202,8 @@ Tcl_AppendUnicodeToObj(
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1680,6 +1686,7 @@ Tcl_AppendFormatToObj(
const char *span = format, *msg, *errCode;
int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0;
int originalLength, limit;
Tcl_UniChar ch = 0;
static const char *mixedXPG =
"cannot mix \"%\" and \"%n$\" conversion specifiers";
static const char *const badIndex[2] = {
@@ -1700,12 +1707,14 @@ Tcl_AppendFormatToObj(
while (*format != '\0') {
char *end;
int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag;
int width, gotPrecision, precision, useShort, useWide, useBig;
int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0;
int width, gotPrecision, precision, sawFlag, useShort = 0, useBig = 0;
#ifndef TCL_WIDE_INT_IS_LONG
int useWide = 0;
#endif
int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes;
Tcl_Obj *segment;
Tcl_UniChar ch;
int step = Tcl_UtfToUniChar(format, &ch);
int step = TclUtfToUniChar(format, &ch);
format += step;
if (ch != '%') {
@@ -1729,7 +1738,7 @@ Tcl_AppendFormatToObj(
* Step 0. Handle special case of escaped format marker (i.e., %%).
*/
step = Tcl_UtfToUniChar(format, &ch);
step = TclUtfToUniChar(format, &ch);
if (ch == '%') {
span = format;
numBytes = step;
@@ -1749,7 +1758,7 @@ Tcl_AppendFormatToObj(
newXpg = 1;
objIndex = position - 1;
format = end + 1;
step = Tcl_UtfToUniChar(format, &ch);
step = TclUtfToUniChar(format, &ch);
}
}
if (newXpg) {
@@ -1777,7 +1786,6 @@ Tcl_AppendFormatToObj(
* Step 2. Set of flags.
*/
gotMinus = gotHash = gotZero = gotSpace = gotPlus = 0;
sawFlag = 1;
do {
switch (ch) {
@@ -1801,7 +1809,7 @@ Tcl_AppendFormatToObj(
}
if (sawFlag) {
format += step;
step = Tcl_UtfToUniChar(format, &ch);
step = TclUtfToUniChar(format, &ch);
}
} while (sawFlag);
@@ -1813,7 +1821,7 @@ Tcl_AppendFormatToObj(
if (isdigit(UCHAR(ch))) {
width = strtoul(format, &end, 10);
format = end;
step = Tcl_UtfToUniChar(format, &ch);
step = TclUtfToUniChar(format, &ch);
} else if (ch == '*') {
if (objIndex >= objc - 1) {
msg = badIndex[gotXpg];
@@ -1829,7 +1837,7 @@ Tcl_AppendFormatToObj(
}
objIndex++;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
step = TclUtfToUniChar(format, &ch);
}
if (width > limit) {
msg = overflow;
@@ -1845,12 +1853,12 @@ Tcl_AppendFormatToObj(
if (ch == '.') {
gotPrecision = 1;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
step = TclUtfToUniChar(format, &ch);
}
if (isdigit(UCHAR(ch))) {
precision = strtoul(format, &end, 10);
format = end;
step = Tcl_UtfToUniChar(format, &ch);
step = TclUtfToUniChar(format, &ch);
} else if (ch == '*') {
if (objIndex >= objc - 1) {
msg = badIndex[gotXpg];
@@ -1871,25 +1879,24 @@ Tcl_AppendFormatToObj(
}
objIndex++;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
step = TclUtfToUniChar(format, &ch);
}
/*
* Step 5. Length modifier.
*/
useShort = useWide = useBig = 0;
if (ch == 'h') {
useShort = 1;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
step = TclUtfToUniChar(format, &ch);
} else if (ch == 'l') {
format += step;
step = Tcl_UtfToUniChar(format, &ch);
step = TclUtfToUniChar(format, &ch);
if (ch == 'l') {
useBig = 1;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
step = TclUtfToUniChar(format, &ch);
#ifndef TCL_WIDE_INT_IS_LONG
} else {
useWide = 1;
@@ -1962,6 +1969,7 @@ Tcl_AppendFormatToObj(
goto error;
}
isNegative = (mp_cmp_d(&big, 0) == MP_LT);
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
Tcl_Obj *objPtr;
@@ -1976,6 +1984,7 @@ Tcl_AppendFormatToObj(
Tcl_DecrRefCount(objPtr);
}
isNegative = (w < (Tcl_WideInt) 0);
#endif
} else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
Tcl_Obj *objPtr;
@@ -2022,8 +2031,11 @@ Tcl_AppendFormatToObj(
segmentLimit -= 1;
precision--;
break;
case 'x':
case 'X':
Tcl_AppendToObj(segment, "0X", 2);
segmentLimit -= 2;
break;
case 'x':
Tcl_AppendToObj(segment, "0x", 2);
segmentLimit -= 2;
break;
@@ -2042,8 +2054,10 @@ Tcl_AppendFormatToObj(
if (useShort) {
pure = Tcl_NewIntObj((int) s);
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
pure = Tcl_NewWideIntObj(w);
#endif
} else if (useBig) {
pure = Tcl_NewBignumObj(&big);
} else {
@@ -2126,6 +2140,7 @@ Tcl_AppendFormatToObj(
numDigits++;
us /= base;
}
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
Tcl_WideUInt uw = (Tcl_WideUInt) w;
@@ -2134,6 +2149,7 @@ Tcl_AppendFormatToObj(
numDigits++;
uw /= base;
}
#endif
} else if (useBig && big.used) {
int leftover = (big.used * DIGIT_BIT) % numBits;
mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover);
@@ -2183,7 +2199,11 @@ Tcl_AppendFormatToObj(
}
digitOffset = (int) (bits % base);
if (digitOffset > 9) {
bytes[numDigits] = 'a' + digitOffset - 10;
if (ch == 'X') {
bytes[numDigits] = 'A' + digitOffset - 10;
} else {
bytes[numDigits] = 'a' + digitOffset - 10;
}
} else {
bytes[numDigits] = '0' + digitOffset;
}
@@ -2305,14 +2325,6 @@ Tcl_AppendFormatToObj(
goto error;
}
switch (ch) {
case 'E':
case 'G':
case 'X': {
Tcl_SetObjLength(segment, Tcl_UtfToUpper(TclGetString(segment)));
}
}
if (width>0 && numChars<0) {
numChars = Tcl_GetCharLength(segment);
}
@@ -2326,7 +2338,7 @@ Tcl_AppendFormatToObj(
}
}
Tcl_GetStringFromObj(segment, &segmentNumBytes);
TclGetStringFromObj(segment, &segmentNumBytes);
if (segmentNumBytes > limit) {
if (allocSegment) {
Tcl_DecrRefCount(segment);
@@ -2684,7 +2696,7 @@ TclStringObjReverse(
Tcl_Obj *objPtr)
{
String *stringPtr;
Tcl_UniChar ch;
Tcl_UniChar ch = 0;
if (TclIsPureByteArray(objPtr)) {
int numBytes;
@@ -2712,7 +2724,6 @@ TclStringObjReverse(
* Tcl_SetObjLength into growing the unicode rep buffer.
*/
ch = 0;
objPtr = Tcl_NewUnicodeObj(&ch, 1);
Tcl_SetObjLength(objPtr, stringPtr->numChars);
to = Tcl_GetUnicode(objPtr);
@@ -2758,7 +2769,7 @@ TclStringObjReverse(
* It's part of the contract for objPtr->bytes values.
* Thus, we can skip calling Tcl_UtfCharComplete() here.
*/
int bytesInChar = Tcl_UtfToUniChar(from, &ch);
int bytesInChar = TclUtfToUniChar(from, &ch);
ReverseBytes((unsigned char *)to, (unsigned char *)from,
bytesInChar);
@@ -2815,7 +2826,7 @@ ExtendUnicodeRepWithString(
{
String *stringPtr = GET_STRING(objPtr);
int needed, numOrigChars = 0;
Tcl_UniChar *dst;
Tcl_UniChar *dst, unichar = 0;
if (stringPtr->hasUnicode) {
numOrigChars = stringPtr->numChars;
@@ -2838,7 +2849,8 @@ ExtendUnicodeRepWithString(
numAppendChars = 0;
}
for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
bytes += TclUtfToUniChar(bytes, dst);
bytes += TclUtfToUniChar(bytes, &unichar);
*dst = unichar;
}
*dst = 0;
}
@@ -3025,6 +3037,16 @@ UpdateStringOfString(
{
String *stringPtr = GET_STRING(objPtr);
/*
* This routine is only called when we need to generate the
* string rep objPtr->bytes because it does not exist -- it is NULL.
* In that circumstance, any lingering claim about the size of
* memory pointed to by that NULL pointer is clearly bogus, and
* needs a reset.
*/
stringPtr->allocated = 0;
if (stringPtr->numChars == 0) {
TclInitStringRep(objPtr, tclEmptyStringRep, 0);
} else {