From 9a9b619c9f29470dab9e33b0c593b7e648224515 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Tue, 26 Dec 2017 12:27:14 +0000 Subject: TclOO: Remove unneeded name manipulation from TclOOCopyObjectCmd. --- generic/tclOOBasic.c | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index b2c06a7..d874cba 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -1206,22 +1206,10 @@ TclOOCopyObjectCmd( o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL); } else { const char *name, *namespaceName; - Tcl_DString buffer; name = TclGetString(objv[2]); - Tcl_DStringInit(&buffer); if (name[0] == '\0') { name = NULL; - } else if (name[0]!=':' || name[1]!=':') { - Interp *iPtr = (Interp *) interp; - - if (iPtr->varFramePtr != NULL) { - Tcl_DStringAppend(&buffer, - iPtr->varFramePtr->nsPtr->fullName, -1); - } - TclDStringAppendLiteral(&buffer, "::"); - Tcl_DStringAppend(&buffer, name, -1); - name = Tcl_DStringValue(&buffer); } /* @@ -1243,7 +1231,6 @@ TclOOCopyObjectCmd( } o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName); - Tcl_DStringFree(&buffer); } if (o2Ptr == NULL) { -- cgit v0.12 From 9a7ce78e965b9066530810b359b0b968667de251 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 28 Dec 2017 18:45:16 +0000 Subject: Make Tcl_WinTCharToUtf/Tcl_WinUtfToTChar work when TCL_UTF_MAX > 3, mainly when sizeof(Tcl_UniChar) != 2. --- doc/Encoding.3 | 4 ---- generic/tclStubInit.c | 34 +++++++++++++++++++++++++++++- unix/tclUnixPort.h | 4 ++-- win/tclWin32Dll.c | 57 +++++++++++++++++++++++++++++++++++++++------------ 4 files changed, 79 insertions(+), 20 deletions(-) diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 81ef508..79fca0f 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -260,10 +260,6 @@ Windows-only convenience functions for converting between UTF-8 and Windows strings based on the TCHAR type which is by convention a Unicode character on Windows NT. -These functions are essentially wrappers around -\fBTcl_UtfToExternalDString\fR and -\fBTcl_ExternalToUtfDString\fR that convert to and from the -Unicode encoding. .PP \fBTcl_GetEncodingName\fR is roughly the inverse of \fBTcl_GetEncoding\fR. Given an \fIencoding\fR, the return value is the \fIname\fR argument that diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index b185f04..679a12b 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -106,7 +106,9 @@ static unsigned short TclWinNToHS(unsigned short ns) { # define TclWinFlushDirtyChannels doNothing # define TclWinResetInterfaces doNothing +#if TCL_UTF_MAX < 4 static Tcl_Encoding winTCharEncoding; +#endif static int TclpIsAtty(int fd) @@ -127,7 +129,7 @@ void *TclWinGetTclInstance() { void *hInstance = NULL; GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, - (const char *)&winTCharEncoding, &hInstance); + (const char *)&TclpIsAtty, &hInstance); return hInstance; } @@ -186,11 +188,24 @@ Tcl_WinUtfToTChar( int len, Tcl_DString *dsPtr) { +#if TCL_UTF_MAX > 3 + WCHAR *wp; + int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0); + + Tcl_DStringInit(dsPtr); + Tcl_DStringSetLength(dsPtr, 2*size+2); + wp = (WCHAR *)Tcl_DStringValue(dsPtr); + MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1); + Tcl_DStringSetLength(dsPtr, 2*size); + wp[size] = 0; + return (char *)wp; +#else if (!winTCharEncoding) { winTCharEncoding = Tcl_GetEncoding(0, "unicode"); } return Tcl_UtfToExternalDString(winTCharEncoding, string, len, dsPtr); +#endif } char * @@ -199,11 +214,28 @@ Tcl_WinTCharToUtf( int len, Tcl_DString *dsPtr) { +#if TCL_UTF_MAX > 3 + char *p; + int size; + + if (len > 0) { + len /= 2; + } + size = WideCharToMultiByte(CP_UTF8, 0, string, len, 0, 0, NULL, NULL); + Tcl_DStringInit(dsPtr); + Tcl_DStringSetLength(dsPtr, size+1); + p = (char *)Tcl_DStringValue(dsPtr); + WideCharToMultiByte(CP_UTF8, 0, string, len, p, size, NULL, NULL); + Tcl_DStringSetLength(dsPtr, size); + p[size] = 0; + return p; +#else if (!winTCharEncoding) { winTCharEncoding = Tcl_GetEncoding(0, "unicode"); } return Tcl_ExternalToUtfDString(winTCharEncoding, string, len, dsPtr); +#endif } #if defined(TCL_WIDE_INT_IS_LONG) diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h index ba56089..4819f10 100644 --- a/unix/tclUnixPort.h +++ b/unix/tclUnixPort.h @@ -87,8 +87,8 @@ typedef off_t Tcl_SeekOffset; typedef unsigned short WCHAR; __declspec(dllimport) extern __stdcall int GetModuleHandleExW(unsigned int, const char *, void *); __declspec(dllimport) extern __stdcall int GetModuleFileNameW(void *, const char *, int); - __declspec(dllimport) extern __stdcall int WideCharToMultiByte(int, int, const char *, int, - const char *, int, const char *, const char *); + __declspec(dllimport) extern __stdcall int WideCharToMultiByte(int, int, const void *, int, + char *, int, const char *, void *); __declspec(dllimport) extern __stdcall int MultiByteToWideChar(int, int, const char *, int, WCHAR *, int); __declspec(dllimport) extern __stdcall void OutputDebugStringW(const WCHAR *); diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 84c7a97..3add0d1 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -33,7 +33,9 @@ static int platformId; /* Running under NT, or 95/98? */ #define cpuid __asm __emit 0fh __asm __emit 0a2h #endif +#if TCL_UTF_MAX < 4 static Tcl_Encoding winTCharEncoding = NULL; +#endif /* * The following declaration is for the VC++ DLL entry point. @@ -49,7 +51,7 @@ BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason, */ typedef struct MountPointMap { - const TCHAR *volumeName; /* Native wide string volume name. */ + TCHAR *volumeName; /* Native wide string volume name. */ TCHAR driveLetter; /* Drive letter corresponding to the volume * name. */ struct MountPointMap *nextPtr; @@ -266,7 +268,7 @@ TclWinNoBackslash( * * TclpSetInterfaces -- * - * A helper proc that initializes winTCharEncoding. + * A helper proc. * * Results: * None. @@ -280,8 +282,10 @@ TclWinNoBackslash( void TclpSetInterfaces(void) { +#if TCL_UTF_MAX < 4 TclWinResetInterfaces(); winTCharEncoding = Tcl_GetEncoding(NULL, "unicode"); +#endif } /* @@ -344,10 +348,12 @@ TclWinEncodingsCleanup(void) void TclWinResetInterfaces(void) { +#if TCL_UTF_MAX < 4 if (winTCharEncoding != NULL) { Tcl_FreeEncoding(winTCharEncoding); winTCharEncoding = NULL; } +#endif } /* @@ -532,13 +538,9 @@ TclWinDriveLetterForVolMountPoint( * (NT) or "char" strings(95). This saves you the trouble of writing the * following type of fragment over and over: * - * if (running NT) { - * encoding <- Tcl_GetEncoding("unicode"); - * nativeBuffer <- UtfToExternal(encoding, utfBuffer); - * Tcl_FreeEncoding(encoding); - * } else { - * nativeBuffer <- UtfToExternal(NULL, utfBuffer); - * } + * encoding <- Tcl_GetEncoding("unicode"); + * nativeBuffer <- UtfToExternal(encoding, utfBuffer); + * Tcl_FreeEncoding(encoding); * * By convention, in Windows a TCHAR is a character in the ANSI code page * on Windows 95, a Unicode character on Windows NT. If you plan on @@ -561,26 +563,55 @@ TclWinDriveLetterForVolMountPoint( TCHAR * Tcl_WinUtfToTChar( const char *string, /* Source string in UTF-8. */ - int len, /* Source string length in bytes, or < 0 for + int len, /* Source string length in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { +#if TCL_UTF_MAX > 3 + TCHAR *wp; + int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0); + + Tcl_DStringInit(dsPtr); + Tcl_DStringSetLength(dsPtr, 2*size+2); + wp = (TCHAR *)Tcl_DStringValue(dsPtr); + MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1); + Tcl_DStringSetLength(dsPtr, 2*size); + wp[size] = 0; + return wp; +#else return (TCHAR *) Tcl_UtfToExternalDString(winTCharEncoding, string, len, dsPtr); +#endif } char * Tcl_WinTCharToUtf( - const TCHAR *string, /* Source string in Unicode when running NT, - * ANSI when running 95. */ - int len, /* Source string length in bytes, or < 0 for + const TCHAR *string, /* Source string in Unicode. */ + int len, /* Source string length in bytes, or -1 for * platform-specific string length. */ Tcl_DString *dsPtr) /* Uninitialized or free DString in which the * converted string is stored. */ { +#if TCL_UTF_MAX > 3 + char *p; + int size; + + if (len > 0) { + len /= 2; + } + size = WideCharToMultiByte(CP_UTF8, 0, string, len, 0, 0, NULL, NULL); + Tcl_DStringInit(dsPtr); + Tcl_DStringSetLength(dsPtr, size+1); + p = (char *)Tcl_DStringValue(dsPtr); + WideCharToMultiByte(CP_UTF8, 0, string, len, p, size, NULL, NULL); + Tcl_DStringSetLength(dsPtr, size); + p[size] = 0; + return p; +#else return Tcl_ExternalToUtfDString(winTCharEncoding, (const char *) string, len, dsPtr); +#endif } /* -- cgit v0.12 From 301f6bcb839b301e1e3d3a92e3713696780c95ca Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 28 Dec 2017 18:49:24 +0000 Subject: Fix handling of surrogates (when TCL_UTF_MAX > 3) in Tcl_UtfNcmp()/Tcl_UtfNcasecmp()/TclUtfCasecmp(). Backported from core-8-branch, where this was fixed already. --- generic/tclPkg.c | 6 +++--- generic/tclUtf.c | 57 ++++++++++++++++++++++++++++---------------------------- 2 files changed, 32 insertions(+), 31 deletions(-) diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 4f6faa8..6d826a9 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -414,7 +414,7 @@ PkgRequireCore( continue; } - + /* Check satisfaction of requirements before considering the current version further. */ if (reqc > 0) { satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv); @@ -424,7 +424,7 @@ PkgRequireCore( continue; } } - + if (bestPtr != NULL) { int res = CompareVersions(availVersion, bestVersion, NULL); @@ -485,7 +485,7 @@ PkgRequireCore( /* * Clean up memorized internal reps, if any. */ - + if (bestVersion != NULL) { ckfree(bestVersion); bestVersion = NULL; diff --git a/generic/tclUtf.c b/generic/tclUtf.c index c60e99e..6255a4e 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -726,8 +726,7 @@ Tcl_UniCharAtIndex( { Tcl_UniChar ch = 0; - while (index >= 0) { - index--; + while (index-- >= 0) { src += TclUtfToUniChar(src, &ch); } return ch; @@ -757,8 +756,7 @@ Tcl_UtfAtIndex( { Tcl_UniChar ch = 0; - while (index > 0) { - index--; + while (index-- > 0) { src += TclUtfToUniChar(src, &ch); } return src; @@ -1072,16 +1070,17 @@ Tcl_UtfNcmp( cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); + if (ch1 != ch2) { #if TCL_UTF_MAX == 4 - /* map high surrogate characters to values > 0xffff */ - if ((ch1 & 0xFC00) == 0xD800) { - ch1 += 0x4000; - } - if ((ch2 & 0xFC00) == 0xD800) { - ch2 += 0x4000; - } + /* Surrogates always report higher than non-surrogates */ + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } + } else if ((ch2 & 0xFC00) == 0xD800) { + return -ch2; + } #endif - if (ch1 != ch2) { return (ch1 - ch2); } } @@ -1122,16 +1121,17 @@ Tcl_UtfNcasecmp( */ cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); + if (ch1 != ch2) { #if TCL_UTF_MAX == 4 - /* map high surrogate characters to values > 0xffff */ - if ((ch1 & 0xFC00) == 0xD800) { - ch1 += 0x4000; - } - if ((ch2 & 0xFC00) == 0xD800) { - ch2 += 0x4000; - } + /* Surrogates always report higher than non-surrogates */ + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } + } else if ((ch2 & 0xFC00) == 0xD800) { + return -ch2; + } #endif - if (ch1 != ch2) { ch1 = Tcl_UniCharToLower(ch1); ch2 = Tcl_UniCharToLower(ch2); if (ch1 != ch2) { @@ -1170,16 +1170,17 @@ TclUtfCasecmp( while (*cs && *ct) { cs += TclUtfToUniChar(cs, &ch1); ct += TclUtfToUniChar(ct, &ch2); + if (ch1 != ch2) { #if TCL_UTF_MAX == 4 - /* map high surrogate characters to values > 0xffff */ - if ((ch1 & 0xFC00) == 0xD800) { - ch1 += 0x4000; - } - if ((ch2 & 0xFC00) == 0xD800) { - ch2 += 0x4000; - } + /* Surrogates always report higher than non-surrogates */ + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } + } else if ((ch2 & 0xFC00) == 0xD800) { + return -ch2; + } #endif - if (ch1 != ch2) { ch1 = Tcl_UniCharToLower(ch1); ch2 = Tcl_UniCharToLower(ch2); if (ch1 != ch2) { -- cgit v0.12 From ad43c617e3fb81c44639a400b8a6d611aa52e3f2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 28 Dec 2017 21:14:40 +0000 Subject: Fix bug introduced in [0dd0d14489258621] (only for TCL_UTF_MAX > 3): If len parameter = -1, returned size includes terminating 0-byte. So, account for that. Also, fix some comments which were not accurate any more, now that Windows 95/98 is not supported any more. --- generic/tclStubInit.c | 2 ++ win/tclWin32Dll.c | 33 ++++++++++++++++----------------- 2 files changed, 18 insertions(+), 17 deletions(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 679a12b..b28d501 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -196,6 +196,7 @@ Tcl_WinUtfToTChar( Tcl_DStringSetLength(dsPtr, 2*size+2); wp = (WCHAR *)Tcl_DStringValue(dsPtr); MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1); + if (len == -1) --size; /* account for 0-byte at string end */ Tcl_DStringSetLength(dsPtr, 2*size); wp[size] = 0; return (char *)wp; @@ -226,6 +227,7 @@ Tcl_WinTCharToUtf( Tcl_DStringSetLength(dsPtr, size+1); p = (char *)Tcl_DStringValue(dsPtr); WideCharToMultiByte(CP_UTF8, 0, string, len, p, size, NULL, NULL); + if (len == -1) --size; /* account for 0-byte at string end */ Tcl_DStringSetLength(dsPtr, size); p[size] = 0; return p; diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 3add0d1..6c973df 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -519,35 +519,32 @@ TclWinDriveLetterForVolMountPoint( * * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf -- * - * Convert between UTF-8 and Unicode when running Windows NT or the - * current ANSI code page when running Windows 95. + * Convert between UTF-8 and Unicode when running Windows. * - * On Mac, Unix, and Windows 95, all strings exchanged between Tcl and - * the OS are "char" oriented. We need only one Tcl_Encoding to convert - * between UTF-8 and the system's native encoding. We use NULL to - * represent that encoding. + * On Mac and Unix, all strings exchanged between Tcl and the OS are + * "char" oriented. We need only one Tcl_Encoding to convert between + * UTF-8 and the system's native encoding. We use NULL to represent + * that encoding. * - * On NT, some strings exchanged between Tcl and the OS are "char" + * On Windows, some strings exchanged between Tcl and the OS are "char" * oriented, while others are in Unicode. We need two Tcl_Encoding APIs * depending on whether we are targeting a "char" or Unicode interface. * - * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding of - * NULL should always used to convert between UTF-8 and the system's + * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding + * of NULL should always used to convert between UTF-8 and the system's * "char" oriented encoding. The following two functions are used in - * Windows-specific code to convert between UTF-8 and Unicode strings - * (NT) or "char" strings(95). This saves you the trouble of writing the + * Windows-specific code to convert between UTF-8 and Unicode strings. + * This saves you the trouble of writing the * following type of fragment over and over: * * encoding <- Tcl_GetEncoding("unicode"); * nativeBuffer <- UtfToExternal(encoding, utfBuffer); * Tcl_FreeEncoding(encoding); * - * By convention, in Windows a TCHAR is a character in the ANSI code page - * on Windows 95, a Unicode character on Windows NT. If you plan on - * targeting a Unicode interfaces when running on NT and a "char" - * oriented interface while running on 95, these functions should be - * used. If you plan on targetting the same "char" oriented function on - * both 95 and NT, use Tcl_UtfToExternal() with an encoding of NULL. + * By convention, in Windows a TCHAR is a Unicode character. If you plan + * on targeting a Unicode interface when running on Windows, these + * functions should be used. If you plan on targetting a "char" oriented + * function on Windows, use Tcl_UtfToExternal() with an encoding of NULL. * * Results: * The result is a pointer to the string in the desired target encoding. @@ -576,6 +573,7 @@ Tcl_WinUtfToTChar( Tcl_DStringSetLength(dsPtr, 2*size+2); wp = (TCHAR *)Tcl_DStringValue(dsPtr); MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1); + if (len == -1) --size; /* account for 0-byte at string end */ Tcl_DStringSetLength(dsPtr, 2*size); wp[size] = 0; return wp; @@ -605,6 +603,7 @@ Tcl_WinTCharToUtf( Tcl_DStringSetLength(dsPtr, size+1); p = (char *)Tcl_DStringValue(dsPtr); WideCharToMultiByte(CP_UTF8, 0, string, len, p, size, NULL, NULL); + if (len == -1) --size; /* account for 0-byte at string end */ Tcl_DStringSetLength(dsPtr, size); p[size] = 0; return p; -- cgit v0.12