summaryrefslogtreecommitdiffstats
path: root/generic/tclStringObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclStringObj.c')
-rw-r--r--generic/tclStringObj.c350
1 files changed, 173 insertions, 177 deletions
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 385ce4f..26a3a28 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -140,8 +140,8 @@ GrowStringBuffer(
objPtr->bytes = NULL;
}
if (flag == 0 || stringPtr->allocated > 0) {
- attempt = 2 * needed;
- if (attempt >= 0) {
+ if (needed <= INT_MAX / 2) {
+ attempt = 2 * needed;
ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
}
if (ptr == NULL) {
@@ -190,8 +190,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) {
@@ -481,8 +481,7 @@ Tcl_GetUniChar(
/*
* 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)) {
@@ -522,7 +521,7 @@ Tcl_GetUniChar(
*
* Get the Unicode form of the String object. If the object is not
* already a String object, it will be converted to one. If the String
- * object does not have a Unicode rep, then one is create from the UTF
+ * object does not have a Unicode rep, then one is created from the UTF
* string format.
*
* Results:
@@ -615,8 +614,7 @@ Tcl_GetRange(
/*
* 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)) {
@@ -656,6 +654,17 @@ Tcl_GetRange(
stringPtr = GET_STRING(objPtr);
}
+#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;
+ }
+#endif
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
}
@@ -1213,9 +1222,9 @@ Tcl_AppendObjToObj(
/*
* Handle append of one bytearray object to another as a special case.
- * Note that we only do this when the objects don't have string reps; if
- * it did, then appending the byte arrays together could well lose
- * information; this is a special-case optimization only.
+ * 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)
@@ -1885,20 +1894,10 @@ Tcl_AppendFormatToObj(
format += step;
step = TclUtfToUniChar(format, &ch);
}
- } else if ((ch == 't') || (ch == 'z')) {
+ } else if ((ch == 't') || (ch == 'z') || (ch == 'q') || (ch == 'j') || (ch == 'L')) {
format += step;
step = TclUtfToUniChar(format, &ch);
-#ifndef TCL_WIDE_INT_IS_LONG
- if (sizeof(size_t) > sizeof(int)) {
- useWide = 1;
- }
-#endif
- } else if ((ch == 'q') ||(ch == 'j')) {
- format += step;
- step = TclUtfToUniChar(format, &ch);
-#ifndef TCL_WIDE_INT_IS_LONG
- useWide = 1;
-#endif
+ useBig = 1;
}
format += step;
@@ -1944,11 +1943,6 @@ Tcl_AppendFormatToObj(
}
case 'u':
- if (useBig) {
- msg = "unsigned bignum format is invalid";
- errCode = "BADUNSIGNED";
- goto errorMsg;
- }
case 'd':
case 'o':
case 'p':
@@ -1968,13 +1962,25 @@ Tcl_AppendFormatToObj(
}
#endif
if (useBig) {
+ int cmpResult;
if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
goto error;
}
- isNegative = (mp_cmp_d(&big, 0) == MP_LT);
+ cmpResult = mp_cmp_d(&big, 0);
+ isNegative = (cmpResult == MP_LT);
+ if (cmpResult == MP_EQ) gotHash = 0;
+ if (ch == 'u') {
+ if (isNegative) {
+ msg = "unsigned bignum format is invalid";
+ errCode = "BADUNSIGNED";
+ goto errorMsg;
+ } else {
+ ch = 'd';
+ }
+ }
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
- if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
+ if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
Tcl_Obj *objPtr;
if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
@@ -1983,13 +1989,14 @@ Tcl_AppendFormatToObj(
mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
- Tcl_GetWideIntFromObj(NULL, objPtr, &w);
+ TclGetWideIntFromObj(NULL, objPtr, &w);
Tcl_DecrRefCount(objPtr);
}
isNegative = (w < (Tcl_WideInt) 0);
+ if (w == (Tcl_WideInt) 0) gotHash = 0;
#endif
} else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
- if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
+ if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
Tcl_Obj *objPtr;
if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
@@ -2006,14 +2013,18 @@ Tcl_AppendFormatToObj(
if (useShort) {
s = (short) l;
isNegative = (s < (short) 0);
+ if (s == (short) 0) gotHash = 0;
} else {
isNegative = (l < (long) 0);
+ if (l == (long) 0) gotHash = 0;
}
} else if (useShort) {
s = (short) l;
isNegative = (s < (short) 0);
+ if (s == (short) 0) gotHash = 0;
} else {
isNegative = (l < (long) 0);
+ if (l == (long) 0) gotHash = 0;
}
segment = Tcl_NewObj();
@@ -2030,16 +2041,12 @@ Tcl_AppendFormatToObj(
if (gotHash || (ch == 'p')) {
switch (ch) {
case 'o':
- Tcl_AppendToObj(segment, "0", 1);
- segmentLimit -= 1;
- precision--;
- break;
- case 'X':
- Tcl_AppendToObj(segment, "0X", 2);
+ Tcl_AppendToObj(segment, "0o", 2);
segmentLimit -= 2;
break;
case 'p':
case 'x':
+ case 'X':
Tcl_AppendToObj(segment, "0x", 2);
segmentLimit -= 2;
break;
@@ -2047,10 +2054,14 @@ Tcl_AppendFormatToObj(
Tcl_AppendToObj(segment, "0b", 2);
segmentLimit -= 2;
break;
+#if TCL_MAJOR_VERSION < 9
case 'd':
- Tcl_AppendToObj(segment, "0d", 2);
- segmentLimit -= 2;
+ if (gotZero) {
+ Tcl_AppendToObj(segment, "0d", 2);
+ segmentLimit -= 2;
+ }
break;
+#endif
}
}
@@ -2188,7 +2199,7 @@ Tcl_AppendFormatToObj(
* Need to be sure zero becomes "0", not "".
*/
- if ((numDigits == 0) && !((ch == 'o') && gotHash)) {
+ if (numDigits == 0) {
numDigits = 1;
}
pure = Tcl_NewObj();
@@ -2255,6 +2266,8 @@ Tcl_AppendFormatToObj(
break;
}
+ case 'a':
+ case 'A':
case 'e':
case 'E':
case 'f':
@@ -2323,6 +2336,12 @@ Tcl_AppendFormatToObj(
errCode = "OVERFLOW";
goto errorMsg;
}
+ if (ch == 'A') {
+ char *p = TclGetString(segment) + 1;
+ *p = 'x';
+ p = strchr(p, 'P');
+ if (p) *p = 'p';
+ }
break;
}
default:
@@ -2528,15 +2547,26 @@ AppendPrintfToObjVA(
Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
va_arg(argList, Tcl_WideInt)));
break;
+ case 3:
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewBignumObj(
+ va_arg(argList, mp_int *)));
+ break;
}
break;
+ case 'a':
+ case 'A':
case 'e':
case 'E':
case 'f':
case 'g':
case 'G':
+ if (size > 0) {
Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
- va_arg(argList, double)));
+ (double)va_arg(argList, long double)));
+ } else {
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
+ va_arg(argList, double)));
+ }
seekingConversion = 0;
break;
case '*':
@@ -2556,7 +2586,6 @@ AppendPrintfToObjVA(
gotPrecision = 1;
p++;
break;
- /* TODO: support for bignum arguments */
case 'l':
++size;
p++;
@@ -2584,6 +2613,10 @@ AppendPrintfToObjVA(
}
p++;
break;
+ case 'L':
+ size = 3;
+ p++;
+ break;
case 'h':
size = -1;
default:
@@ -2697,23 +2730,24 @@ TclGetStringStorage(
* Performs the [string repeat] function.
*
* Results:
- * A standard Tcl result.
+ * A (Tcl_Obj *) pointing to the result value, or NULL in case of an
+ * error.
*
* Side effects:
- * Writes to *objPtrPtr the address of Tcl_Obj that is concatenation
- * of count copies of the value in objPtr.
+ * On error, when interp is not NULL, error information is left in it.
*
*---------------------------------------------------------------------------
*/
-int
+Tcl_Obj *
TclStringRepeat(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
int count,
- Tcl_Obj **objPtrPtr)
+ int flags)
{
Tcl_Obj *objResultPtr;
+ int inPlace = flags & TCL_STRING_IN_PLACE;
int length = 0, unichar = 0, done = 1;
int binary = TclIsPureByteArray(objPtr);
@@ -2748,8 +2782,7 @@ TclStringRepeat(
if (length == 0) {
/* Any repeats of empty is empty. */
- *objPtrPtr = objPtr;
- return TCL_OK;
+ return objPtr;
}
if (count > INT_MAX/length) {
@@ -2758,13 +2791,13 @@ TclStringRepeat(
"max size for a Tcl value (%d bytes) exceeded", INT_MAX));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
if (binary) {
/* Efficiently produce a pure byte array result */
- objResultPtr = Tcl_IsShared(objPtr) ? Tcl_DuplicateObj(objPtr)
- : objPtr;
+ objResultPtr = (!inPlace || Tcl_IsShared(objPtr)) ?
+ Tcl_DuplicateObj(objPtr) : objPtr;
Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */
Tcl_SetByteArrayLength(objResultPtr, length);
@@ -2777,7 +2810,7 @@ TclStringRepeat(
(count - done) * length);
} else if (unichar) {
/* Efficiently produce a pure Tcl_UniChar array result */
- if (Tcl_IsShared(objPtr)) {
+ if (!inPlace || Tcl_IsShared(objPtr)) {
objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length);
} else {
TclInvalidateStringRep(objPtr);
@@ -2788,11 +2821,11 @@ TclStringRepeat(
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"string size overflow: unable to alloc %"
- TCL_LL_MODIFIER "d bytes",
- (Tcl_WideUInt)STRING_SIZE(count*length)));
+ TCL_Z_MODIFIER "u bytes",
+ STRING_SIZE(count*length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
Tcl_SetObjLength(objResultPtr, length);
while (count - done > done) {
@@ -2803,7 +2836,7 @@ TclStringRepeat(
(count - done) * length);
} else {
/* Efficiently concatenate string reps */
- if (Tcl_IsShared(objPtr)) {
+ if (!inPlace || Tcl_IsShared(objPtr)) {
objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length);
} else {
TclFreeIntRep(objPtr);
@@ -2816,7 +2849,7 @@ TclStringRepeat(
count*length));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
Tcl_SetObjLength(objResultPtr, length);
while (count - done > done) {
@@ -2826,47 +2859,45 @@ TclStringRepeat(
Tcl_AppendToObj(objResultPtr, Tcl_GetString(objResultPtr),
(count - done) * length);
}
- *objPtrPtr = objResultPtr;
- return TCL_OK;
+ return objResultPtr;
}
/*
*---------------------------------------------------------------------------
*
- * TclStringCatObjv --
+ * TclStringCat --
*
* Performs the [string cat] function.
*
* Results:
- * A standard Tcl result.
+ * A (Tcl_Obj *) pointing to the result value, or NULL in case of an
+ * error.
*
* Side effects:
- * Writes to *objPtrPtr the address of Tcl_Obj that is concatenation
- * of all objc values in objv.
+ * On error, when interp is not NULL, error information is left in it.
*
*---------------------------------------------------------------------------
*/
-int
-TclStringCatObjv(
+Tcl_Obj *
+TclStringCat(
Tcl_Interp *interp,
- int inPlace,
int objc,
Tcl_Obj * const objv[],
- Tcl_Obj **objPtrPtr)
+ int flags)
{
Tcl_Obj *objResultPtr, * const *ov;
int oc, length = 0, binary = 1;
int allowUniChar = 1, requestUniChar = 0;
int first = objc - 1; /* Index of first value possibly not empty */
int 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 */
- *objPtrPtr = objc ? objv[0] : Tcl_NewObj();
- return TCL_OK;
+ return objc ? objv[0] : Tcl_NewObj();
}
/* assert ( objc >= 2 ) */
@@ -2882,7 +2913,9 @@ TclStringCatObjv(
do {
Tcl_Obj *objPtr = *ov++;
- if (objPtr->bytes) {
+ if (TclIsPureByteArray(objPtr)) {
+ allowUniChar = 0;
+ } else if (objPtr->bytes) {
/* Value has a string rep. */
if (objPtr->length) {
/*
@@ -2897,17 +2930,13 @@ TclStringCatObjv(
}
} else {
/* assert (objPtr->typePtr != NULL) -- stork! */
- if (TclIsPureByteArray(objPtr)) {
- allowUniChar = 0;
+ binary = 0;
+ if (objPtr->typePtr == &tclStringType) {
+ /* Have a pure Unicode value; ask to preserve it */
+ requestUniChar = 1;
} else {
- binary = 0;
- if (objPtr->typePtr == &tclStringType) {
- /* Have a pure Unicode value; ask to preserve it */
- requestUniChar = 1;
- } else {
- /* Have another type; prevent shimmer */
- allowUniChar = 0;
- }
+ /* Have another type; prevent shimmer */
+ allowUniChar = 0;
}
}
} while (--oc && (binary || allowUniChar));
@@ -3043,8 +3072,7 @@ TclStringCatObjv(
if (last <= first /*|| length == 0 */) {
/* Only one non-empty value or zero length; return first */
/* NOTE: (length == 0) implies (last <= first) */
- *objPtrPtr = objv[first];
- return TCL_OK;
+ return objv[first];
}
objv += first; objc = (last - first + 1);
@@ -3094,11 +3122,11 @@ TclStringCatObjv(
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %"
- TCL_LL_MODIFIER "d bytes",
- (Tcl_WideUInt)STRING_SIZE(length)));
+ TCL_Z_MODIFIER "u bytes",
+ STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
dst = Tcl_GetUnicode(objResultPtr) + start;
} else {
@@ -3111,11 +3139,11 @@ TclStringCatObjv(
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %"
- TCL_LL_MODIFIER "d bytes",
- (Tcl_WideUInt)STRING_SIZE(length)));
+ TCL_Z_MODIFIER "u bytes",
+ STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
dst = Tcl_GetUnicode(objResultPtr);
}
@@ -3146,7 +3174,7 @@ TclStringCatObjv(
length));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
dst = Tcl_GetString(objResultPtr) + start;
@@ -3162,7 +3190,7 @@ TclStringCatObjv(
length));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
dst = Tcl_GetString(objResultPtr);
}
@@ -3177,8 +3205,7 @@ TclStringCatObjv(
}
}
}
- *objPtrPtr = objResultPtr;
- return TCL_OK;
+ return objResultPtr;
overflow:
if (interp) {
@@ -3186,13 +3213,13 @@ TclStringCatObjv(
"max size for a Tcl value (%d bytes) exceeded", INT_MAX));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
- return TCL_ERROR;
+ return NULL;
}
/*
*---------------------------------------------------------------------------
*
- * TclStringFind --
+ * TclStringFirst --
*
* Implements the [string first] operation.
*
@@ -3208,20 +3235,20 @@ TclStringCatObjv(
*/
int
-TclStringFind(
+TclStringFirst(
Tcl_Obj *needle,
Tcl_Obj *haystack,
int start)
{
int lh, ln = Tcl_GetCharLength(needle);
+ if (start < 0) {
+ start = 0;
+ }
if (ln == 0) {
- /*
- * We don't find empty substrings. Bizarre!
- *
- * TODO: When we one day make this a true substring
- * finder, change this to "return 0"
- */
+ /* We don't find empty substrings. Bizarre!
+ * Whenever this routine is turned into a proper substring
+ * finder, change to `return start` after limits imposed. */
return -1;
}
@@ -3229,51 +3256,46 @@ TclStringFind(
unsigned char *end, *try, *bh;
unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);
+ /* Find bytes in bytes */
bh = Tcl_GetByteArrayFromObj(haystack, &lh);
end = bh + lh;
try = bh + start;
while (try + ln <= end) {
- try = memchr(try, bn[0], end - try);
-
+ /*
+ * Look for the leading byte of the needle in the haystack
+ * starting at try and stopping when there's not enough room
+ * for the needle left.
+ */
+ try = memchr(try, bn[0], (end + 1 - ln) - try);
if (try == NULL) {
+ /* Leading byte not found -> needle cannot be found. */
return -1;
}
+ /* Leading byte found, check rest of needle. */
if (0 == memcmp(try+1, bn+1, ln-1)) {
+ /* Checks! Return the successful index. */
return (try - bh);
}
+ /* Rest of needle match failed; Iterate to continue search. */
try++;
}
return -1;
}
/*
- * Check if we have two strings of single-byte characters. If we have, we
- * can use strstr() to do the search. Note that we can sometimes have
- * multibyte characters when the string could be minimally represented
- * using single byte characters; we can't assume that a mismatch here
- * means no match.
+ * TODO: It might be nice to support some cases where it is not
+ * necessary to shimmer to &tclStringType to compute the result,
+ * and instead operate just on the objPtr->bytes values directly.
+ * However, we also do not want the answer to change based on the
+ * code pathway, or if it does we want that to be for some values
+ * we explicitly decline to support. Getting there will involve
+ * locking down in practice more firmly just what encodings produce
+ * what supported results for the objPtr->bytes values. For now,
+ * do only the well-defined Tcl_UniChar array search.
*/
- lh = Tcl_GetCharLength(haystack);
- if (haystack->bytes && (lh == haystack->length) && needle->bytes
- && (ln == needle->length)) {
- /*
- * Both haystack and needle are all single-byte chars.
- */
-
- char *found = strstr(haystack->bytes + start, needle->bytes);
-
- if (found) {
- return (found - haystack->bytes);
- } else {
- return -1;
- }
- } else {
- /*
- * Do the search on the unicode representation for simplicity.
- */
-
+ {
Tcl_UniChar *try, *end, *uh;
Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);
@@ -3321,24 +3343,24 @@ TclStringLast(
* We don't find empty substrings. Bizarre!
*
* TODO: When we one day make this a true substring
- * finder, change this to "return 0"
+ * finder, change this to "return last", after limitation.
*/
return -1;
}
- if (ln > last + 1) {
+ lh = Tcl_GetCharLength(haystack);
+ if (last >= lh) {
+ last = lh - 1;
+ }
+
+ if (last < ln - 1) {
return -1;
}
if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
- unsigned char *try, *bh;
+ unsigned char *try, *bh = Tcl_GetByteArrayFromObj(haystack, &lh);
unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);
- bh = Tcl_GetByteArrayFromObj(haystack, &lh);
-
- if (last + 1 > lh) {
- last = lh - 1;
- }
try = bh + last + 1 - ln;
while (try >= bh) {
if ((*try == bn[0])
@@ -3350,38 +3372,10 @@ TclStringLast(
return -1;
}
- lh = Tcl_GetCharLength(haystack);
- if (last + 1 > lh) {
- last = lh - 1;
- }
- if (haystack->bytes && (lh == haystack->length)) {
- /* haystack is all single-byte chars */
-
- if (needle->bytes && (ln == needle->length)) {
- /* needle is also all single-byte chars */
-
- char *try = haystack->bytes + last + 1 - ln;
- while (try >= haystack->bytes) {
- if ((*try == needle->bytes[0])
- && (0 == memcmp(try+1, needle->bytes + 1, ln - 1))) {
- return (try - haystack->bytes);
- }
- try--;
- }
- return -1;
- } else {
- /*
- * Cannot find substring with a multi-byte char inside
- * a string with no multi-byte chars.
- */
- return -1;
- }
- } else {
- Tcl_UniChar *try, *uh;
+ {
+ Tcl_UniChar *try, *uh = Tcl_GetUnicodeFromObj(haystack, &lh);
Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);
- uh = Tcl_GetUnicodeFromObj(haystack, &lh);
-
try = uh + last + 1 - ln;
while (try >= uh) {
if ((*try == un[0])
@@ -3397,14 +3391,14 @@ TclStringLast(
/*
*---------------------------------------------------------------------------
*
- * TclStringObjReverse --
+ * TclStringReverse --
*
* Implements the [string reverse] operation.
*
* Results:
- * An unshared Tcl value which is the [string reverse] of the argument
- * supplied. When sharing rules permit, the returned value might be the
- * argument with modifications done in place.
+ * A Tcl value which is the [string reverse] of the argument supplied.
+ * When sharing rules permit and the caller requests, the returned value
+ * might be the argument with modifications done in place.
*
* Side effects:
* May allocate a new Tcl_Obj.
@@ -3435,17 +3429,19 @@ ReverseBytes(
}
Tcl_Obj *
-TclStringObjReverse(
- Tcl_Obj *objPtr)
+TclStringReverse(
+ Tcl_Obj *objPtr,
+ int flags)
{
String *stringPtr;
Tcl_UniChar ch = 0;
+ int inPlace = flags & TCL_STRING_IN_PLACE;
if (TclIsPureByteArray(objPtr)) {
int numBytes;
unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);
- if (Tcl_IsShared(objPtr)) {
+ if (!inPlace || Tcl_IsShared(objPtr)) {
objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
}
ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
@@ -3459,7 +3455,7 @@ TclStringObjReverse(
Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
Tcl_UniChar *src = from + stringPtr->numChars;
- if (Tcl_IsShared(objPtr)) {
+ if (!inPlace || Tcl_IsShared(objPtr)) {
Tcl_UniChar *to;
/*
@@ -3488,7 +3484,7 @@ TclStringObjReverse(
int numBytes = objPtr->length;
char *to, *from = objPtr->bytes;
- if (Tcl_IsShared(objPtr)) {
+ if (!inPlace || Tcl_IsShared(objPtr)) {
objPtr = Tcl_NewObj();
Tcl_SetObjLength(objPtr, numBytes);
}
generated by cgit v0.12 at 2024-11-17 05:15:47 (GMT)