Add TclGetRange() to the compatibility set

5 files changed, 77 insertions, 3 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index cb6e282..f6a4c05 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2463,6 +2463,9 @@ declare 670 {
 declare 671 {
     const char *TclUtfAtIndex(const char *src, int index)
 }
+declare 672 {
+    Tcl_Obj *TclGetRange(Tcl_Obj *objPtr, int first, int last)
+}
 
 
 # ----- BASELINE -- FOR -- 8.7.0 ----- #
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 06ee797..fdf8673 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1969,6 +1969,8 @@ EXTERN int		TclNumUtfChars(const char *src, int length);
 EXTERN int		TclGetCharLength(Tcl_Obj *objPtr);
 /* 671 */
 EXTERN const char *	TclUtfAtIndex(const char *src, int index);
+/* 672 */
+EXTERN Tcl_Obj *	TclGetRange(Tcl_Obj *objPtr, int first, int last);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -2676,6 +2678,7 @@ typedef struct TclStubs {
     int (*tclNumUtfChars) (const char *src, int length); /* 669 */
     int (*tclGetCharLength) (Tcl_Obj *objPtr); /* 670 */
     const char * (*tclUtfAtIndex) (const char *src, int index); /* 671 */
+    Tcl_Obj * (*tclGetRange) (Tcl_Obj *objPtr, int first, int last); /* 672 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -4043,6 +4046,8 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tclGetCharLength) /* 670 */
 #define TclUtfAtIndex \
 	(tclStubsPtr->tclUtfAtIndex) /* 671 */
+#define TclGetRange \
+	(tclStubsPtr->tclGetRange) /* 672 */
 
 #endif /* defined(USE_TCL_STUBS) */
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6804996..7486d60 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3333,6 +3333,8 @@ MODULE_SCOPE int    TclZipfs_Init(Tcl_Interp *interp);
 #   define Tcl_GetCharLength TclGetCharLength
 #   undef Tcl_UtfAtIndex
 #   define Tcl_UtfAtIndex TclUtfAtIndex
+#   undef Tcl_GetRange
+#   define Tcl_GetRange TclGetRange
 #else
 #   define tclUniCharStringType tclStringType
 #   define TclGetUnicodeFromObj_ Tcl_GetUnicodeFromObj
@@ -3345,8 +3347,8 @@ MODULE_SCOPE int    TclZipfs_Init(Tcl_Interp *interp);
 #   define TclNumUtfChars Tcl_NumUtfChars
 #   undef TclGetCharLength
 #   define TclGetCharLength Tcl_GetCharLength
-#   undef TclUtfAtIndex
-#   define TclUtfAtIndex Tcl_UtfAtIndex
+#   undef TclGetRange
+#   define TclGetRange Tcl_GetRange
 #endif
 
 
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 627fadc..332d1d2 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -110,7 +110,6 @@ const Tcl_ObjType tclStringType = {
 
 #else
 
-#define tclStringType xxx
 #ifndef TCL_NO_DEPRECATED
 const Tcl_ObjType tclStringType = {
     "string",			/* name */
@@ -952,6 +951,8 @@ TclGetUnicodeFromObj(
  *----------------------------------------------------------------------
  */
 
+#if TCL_UTF_MAX > 3 && !defined(TCL_NO_DEPRECATED)
+#undef Tcl_GetRange
 Tcl_Obj *
 Tcl_GetRange(
     Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
@@ -959,6 +960,66 @@ Tcl_GetRange(
     int last)			/* Last index of the range. */
 {
     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
+     * we don't need to convert to a string to perform the substring operation.
+     */
+
+    if (TclIsPureByteArray(objPtr)) {
+	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
+
+	if (last < 0 || last >= length) {
+	    last = length - 1;
+	}
+	if (last < first) {
+	    TclNewObj(newObjPtr);
+	    return newObjPtr;
+	}
+	return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
+    }
+
+    /*
+     * OK, need to work with the object as a utf16 string.
+     */
+
+    SetUTF16StringFromAny(NULL, objPtr);
+    stringPtr = GET_STRING(objPtr);
+
+    if (last < 0 || last >= stringPtr->numChars) {
+	last = stringPtr->numChars - 1;
+    }
+    if (last < first) {
+	TclNewObj(newObjPtr);
+	return newObjPtr;
+    }
+    /* 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;
+    }
+    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
+}
+#endif
+
+Tcl_Obj *
+TclGetRange(
+    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
+    int first,			/* First index of the range. */
+    int last)			/* Last index of the range. */
+{
+    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
     UniCharString *stringPtr;
     int length;
 
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 131053a..2046938 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -48,6 +48,7 @@
 #undef Tcl_UniCharCaseMatch
 #undef Tcl_UniCharLen
 #undef Tcl_UniCharNcmp
+#undef Tcl_GetRange
 #undef Tcl_DumpActiveMemory
 #undef Tcl_ValidateAllMemory
 #undef Tcl_FindHashEntry
@@ -98,6 +99,7 @@ static void uniCodePanic(void) {
 #   define Tcl_UniCharNcmp (int(*)(const unsigned short *, const unsigned short *, unsigned long))(void *)uniCodePanic
 #   define Tcl_UniCharNcasecmp (int(*)(const unsigned short *, const unsigned short *, unsigned long))(void *)uniCodePanic
 #   define Tcl_UniCharCaseMatch (int(*)(const unsigned short *, const unsigned short *, int))(void *)uniCodePanic
+#   define Tcl_GetRange (Tcl_Obj *(*)(Tcl_Obj *, int, int))(void *)uniCodePanic
 #endif
 
 #define TclUtfCharComplete UtfCharComplete
@@ -1957,6 +1959,7 @@ const TclStubs tclStubs = {
     TclNumUtfChars, /* 669 */
     TclGetCharLength, /* 670 */
     TclUtfAtIndex, /* 671 */
+    TclGetRange, /* 672 */
 };
 
 /* !END!: Do not edit above this line. */