More progress

6 files changed, 71 insertions, 39 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 6dbb457..f5b2e78 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -1338,7 +1338,7 @@ declare 377 {
     void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr)
 }
 declare 378 {
-    Tcl_Obj *Tcl_NewUnicodeObj(const unsigned char *unicode, int numChars)
+    Tcl_Obj *Tcl_NewUnicodeObj(const unsigned short *unicode, int numChars)
 }
 declare 379 {
     void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const unsigned short *unicode,
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index bf15862..1952641 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1142,7 +1142,7 @@ EXTERN int		Tcl_RegExpExecObj(Tcl_Interp *interp,
 EXTERN void		Tcl_RegExpGetInfo(Tcl_RegExp regexp,
 				Tcl_RegExpInfo *infoPtr);
 /* 378 */
-EXTERN Tcl_Obj *	Tcl_NewUnicodeObj(const unsigned char *unicode,
+EXTERN Tcl_Obj *	Tcl_NewUnicodeObj(const unsigned short *unicode,
 				int numChars);
 /* 379 */
 EXTERN void		Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
@@ -2370,7 +2370,7 @@ typedef struct TclStubs {
     int (*tcl_UniCharIsPunct) (int ch); /* 375 */
     int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */
     void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */
-    Tcl_Obj * (*tcl_NewUnicodeObj) (const unsigned char *unicode, int numChars); /* 378 */
+    Tcl_Obj * (*tcl_NewUnicodeObj) (const unsigned short *unicode, int numChars); /* 378 */
     void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const unsigned short *unicode, int numChars); /* 379 */
     int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
     int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index ed607cd..2a04aca 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3319,12 +3319,21 @@ MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
 MODULE_SCOPE int    TclZipfs_Init(Tcl_Interp *interp);
 
 
-MODULE_SCOPE int *TclGetUnicodeFromObj_(Tcl_Obj *, int *);
-MODULE_SCOPE Tcl_Obj *TclNewUnicodeObj(const int *, int);
-MODULE_SCOPE void TclAppendUnicodeToObj(Tcl_Obj *, const int *, int);
-MODULE_SCOPE int TclUniCharNcasecmp(const int *, const int *, unsigned long);
-MODULE_SCOPE int TclUniCharCaseMatch(const int *, const int *, int);
-MODULE_SCOPE int TclUniCharNcmp(const int *, const int *, unsigned long);
+#if TCL_UTF_MAX > 3
+    MODULE_SCOPE int *TclGetUnicodeFromObj_(Tcl_Obj *, int *);
+    MODULE_SCOPE Tcl_Obj *TclNewUnicodeObj(const int *, int);
+    MODULE_SCOPE void TclAppendUnicodeToObj(Tcl_Obj *, const int *, int);
+    MODULE_SCOPE int TclUniCharNcasecmp(const int *, const int *, unsigned long);
+    MODULE_SCOPE int TclUniCharCaseMatch(const int *, const int *, int);
+    MODULE_SCOPE int TclUniCharNcmp(const int *, const int *, unsigned long);
+#else
+#   define TclGetUnicodeFromObj_ Tcl_GetUnicodeFromObj
+#   define TclNewUnicodeObj Tcl_NewUnicodeObj
+#   define TclAppendUnicodeToObj Tcl_AppendUnicodeToObj
+#   define TclUniCharNcasecmp Tcl_UniCharNcasecmp
+#   define TclUniCharCaseMatch Tcl_UniCharCaseMatch
+#   define TclUniCharNcmp Tcl_UniCharNcmp
+#endif
 
 
 /*
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 8730331..eb5103d 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -55,8 +55,6 @@ static void		AppendUtfToUtfRep(Tcl_Obj *objPtr,
 			    const char *bytes, int numBytes);
 static void		DupStringInternalRep(Tcl_Obj *objPtr,
 			    Tcl_Obj *copyPtr);
-static void		DupUTF16StringInternalRep(Tcl_Obj *objPtr,
-			    Tcl_Obj *copyPtr);
 static int		ExtendStringRepWithUnicode(Tcl_Obj *objPtr,
 			    const Tcl_UniChar *unicode, int numChars);
 static void		ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
@@ -67,12 +65,16 @@ 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 int		SetUTF16StringFromAny(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);
 static void		UpdateStringOfString(Tcl_Obj *objPtr);
+#if TCL_UTF_MAX < 4
+static void		DupUTF16StringInternalRep(Tcl_Obj *objPtr,
+			    Tcl_Obj *copyPtr);
+static int		SetUTF16StringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void		UpdateStringOfUTF16String(Tcl_Obj *objPtr);
+#endif
 
 #define ISCONTINUATION(bytes) (\
 	((((bytes)[0] & 0xC0) == 0x80) || (((bytes)[0] == '\xED') \
@@ -84,6 +86,12 @@ static void		UpdateStringOfUTF16String(Tcl_Obj *objPtr);
  * functions that can be invoked by generic object code.
  */
 
+#if TCL_UTF_MAX > 3
+
+#define utf32StringType tclStringType
+
+#else
+
 static const Tcl_ObjType utf32StringType = {
     "utf32string",			/* name */
     FreeStringInternalRep,	/* freeIntRepPro */
@@ -125,7 +133,7 @@ DupUTF16StringInternalRep(
     size_t size = offsetof(UTF16String, unicode) + (((srcStringPtr->numChars) + 1U) * sizeof(unsigned short));
     UTF16String *copyStringPtr = (UTF16String *)ckalloc(size);
     memcpy(copyStringPtr, srcStringPtr, size);
-    copyStringPtr->allocated = srcStringPtr->numChars;
+    copyStringPtr->allocated = srcStringPtr->numChars + 1;
     copyStringPtr->maxChars = srcStringPtr->numChars;
 
     copyPtr->internalRep.twoPtrValue.ptr1 = copyStringPtr;
@@ -156,7 +164,7 @@ SetUTF16StringFromAny(
 	 */
 
 	stringPtr->numChars = 0;
-	stringPtr->allocated = objPtr->length;
+	stringPtr->allocated = objPtr->length + 1;
 	stringPtr->maxChars = objPtr->length;
 	stringPtr->hasUnicode = 1;
 	objPtr->internalRep.twoPtrValue.ptr1 = stringPtr;
@@ -172,6 +180,8 @@ UpdateStringOfUTF16String(
     (void)objPtr;
 }
 
+#endif
+
 /*
  * TCL STRING GROWTH ALGORITHM
  *
@@ -459,7 +469,7 @@ Tcl_DbNewStringObj(
 
 Tcl_Obj *
 TclNewUnicodeObj(
-    const int *unicode,	/* The unicode string used to initialize the
+    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
 				 * new object. */
     int numChars)		/* Number of characters in the unicode
 				 * string. */
@@ -471,9 +481,10 @@ TclNewUnicodeObj(
     return objPtr;
 }
 
+#if TCL_UTF_MAX > 3
 Tcl_Obj *
 Tcl_NewUnicodeObj(
-    const unsigned char *unicode,	/* The unicode string used to initialize the
+    const unsigned short *unicode,	/* The unicode string used to initialize the
 				 * new object. */
     int numChars)		/* Number of characters in the unicode
 				 * string. */
@@ -486,6 +497,7 @@ Tcl_NewUnicodeObj(
     /* TODO JN */
     return objPtr;
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -740,7 +752,7 @@ Tcl_GetUnicode(
  *----------------------------------------------------------------------
  */
 
-int *
+Tcl_UniChar *
 TclGetUnicodeFromObj_(
     Tcl_Obj *objPtr,		/* The object to find the unicode string
 				 * for. */
@@ -764,6 +776,7 @@ TclGetUnicodeFromObj_(
     return stringPtr->unicode;
 }
 
+#if TCL_UTF_MAX > 3
 unsigned short *
 Tcl_GetUnicodeFromObj(
     Tcl_Obj *objPtr,		/* The object to find the unicode string
@@ -778,6 +791,7 @@ Tcl_GetUnicodeFromObj(
     /* TODO JN */
     return NULL;
 }
+#endif
 
 unsigned short *
 TclGetUnicodeFromObj(
@@ -1400,7 +1414,7 @@ Tcl_AppendToObj(
 void
 TclAppendUnicodeToObj(
     Tcl_Obj *objPtr,		/* Points to the object to append to. */
-    const int *unicode,	/* The unicode string to append to the
+    const Tcl_UniChar *unicode,	/* The unicode string to append to the
 				 * object. */
     int length)			/* Number of chars in "unicode". */
 {
@@ -1430,6 +1444,7 @@ TclAppendUnicodeToObj(
     }
 }
 
+#if TCL_UTF_MAX > 3
 void
 Tcl_AppendUnicodeToObj(
     Tcl_Obj *objPtr,		/* Points to the object to append to. */
@@ -1443,6 +1458,7 @@ Tcl_AppendUnicodeToObj(
 
     /* TODO JN */
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 9814cfe..9884a9a 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -1073,8 +1073,9 @@ TestobjCmd(
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
 	} else {
 	    typeName = objv[2]->typePtr->name;
+	    if (!strcmp(typeName, "utf32string")) typeName = "string";
 #ifndef TCL_WIDE_INT_IS_LONG
-	    if (!strcmp(typeName, "wideInt")) typeName = "int";
+	    else if (!strcmp(typeName, "wideInt")) typeName = "int";
 #endif
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
 	}
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 68a0e32..02f4358 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -1850,8 +1850,8 @@ Tcl_UniCharLen(
 
 int
 TclUniCharNcmp(
-    const int *ucs,	/* Unicode string to compare to uct. */
-    const int *uct,	/* Unicode string ucs is compared to. */
+    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
+    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
     unsigned long numChars)	/* Number of unichars to compare. */
 {
 #if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
@@ -1875,6 +1875,7 @@ TclUniCharNcmp(
 #endif /* WORDS_BIGENDIAN */
 }
 
+#if TCL_UTF_MAX > 3
 int
 Tcl_UniCharNcmp(
     const unsigned short *ucs,	/* Unicode string to compare to uct. */
@@ -1907,6 +1908,7 @@ Tcl_UniCharNcmp(
     return 0;
 #endif /* WORDS_BIGENDIAN */
 }
+#endif
 /*
  *----------------------------------------------------------------------
  *
@@ -1926,23 +1928,17 @@ Tcl_UniCharNcmp(
  */
 
 int
-Tcl_UniCharNcasecmp(
-    const unsigned short *ucs,	/* Unicode string to compare to uct. */
-    const unsigned short *uct,	/* Unicode string ucs is compared to. */
+TclUniCharNcasecmp(
+    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
+    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
     unsigned long numChars)	/* Number of unichars to compare. */
 {
     for ( ; numChars != 0; numChars--, ucs++, uct++) {
 	if (*ucs != *uct) {
-	    unsigned short lcs = Tcl_UniCharToLower(*ucs);
-	    unsigned short lct = Tcl_UniCharToLower(*uct);
+	    int lcs = Tcl_UniCharToLower(*ucs);
+	    int lct = Tcl_UniCharToLower(*uct);
 
 	    if (lcs != lct) {
-	    /* special case for handling upper surrogates */
-	    if (((lcs & 0xFC00) == 0xD800) && ((lct & 0xFC00) != 0xD800)) {
-		return 1;
-	    } else if (((lct & 0xFC00) == 0xD800)) {
-		return -1;
-	    }
 		return (lcs - lct);
 	    }
 	}
@@ -1950,24 +1946,32 @@ Tcl_UniCharNcasecmp(
     return 0;
 }
 
+#if TCL_UTF_MAX > 3
 int
-TclUniCharNcasecmp(
-    const int *ucs,	/* Unicode string to compare to uct. */
-    const int *uct,	/* Unicode string ucs is compared to. */
+Tcl_UniCharNcasecmp(
+    const unsigned short *ucs,	/* Unicode string to compare to uct. */
+    const unsigned short *uct,	/* Unicode string ucs is compared to. */
     unsigned long numChars)	/* Number of unichars to compare. */
 {
     for ( ; numChars != 0; numChars--, ucs++, uct++) {
 	if (*ucs != *uct) {
-	    int lcs = Tcl_UniCharToLower(*ucs);
-	    int lct = Tcl_UniCharToLower(*uct);
+	    unsigned short lcs = Tcl_UniCharToLower(*ucs);
+	    unsigned short lct = Tcl_UniCharToLower(*uct);
 
 	    if (lcs != lct) {
+	    /* special case for handling upper surrogates */
+	    if (((lcs & 0xFC00) == 0xD800) && ((lct & 0xFC00) != 0xD800)) {
+		return 1;
+	    } else if (((lct & 0xFC00) == 0xD800)) {
+		return -1;
+	    }
 		return (lcs - lct);
 	    }
 	}
     }
     return 0;
 }
+#endif
 
 
 /*
@@ -2333,8 +2337,8 @@ Tcl_UniCharIsWordChar(
 
 int
 TclUniCharCaseMatch(
-    const int *uniStr,	/* Unicode String. */
-    const int *uniPattern,
+    const Tcl_UniChar *uniStr,	/* Unicode String. */
+    const Tcl_UniChar *uniPattern,
 				/* Pattern, which may contain special
 				 * characters. */
     int nocase)			/* 0 for case sensitive, 1 for insensitive */
@@ -2498,6 +2502,7 @@ TclUniCharCaseMatch(
     }
 }
 
+#if TCL_UTF_MAX > 3
 int
 Tcl_UniCharCaseMatch(
     const unsigned short *uniStr,	/* Unicode String. */
@@ -2664,6 +2669,7 @@ Tcl_UniCharCaseMatch(
 	uniPattern++;
     }
 }
+#endif
 
 
 /*