summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.travis.yml31
-rw-r--r--generic/tclEncoding.c49
-rw-r--r--generic/tclMain.c17
-rw-r--r--generic/tclUtf.c12
-rw-r--r--generic/tclUtil.c2
-rw-r--r--generic/tclZipfs.c2
-rw-r--r--tests/encoding.test7
-rw-r--r--win/tclWinFile.c32
8 files changed, 98 insertions, 54 deletions
diff --git a/.travis.yml b/.travis.yml
index 34d4176..77ba068 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -122,6 +122,22 @@ matrix:
- BUILD_DIR=win
- CFGOPT=--host=i686-w64-mingw32
- NO_DIRECT_TEST=1
+ - os: linux
+ dist: xenial
+ compiler: i686-w64-mingw32-gcc
+ addons:
+ apt:
+ packages:
+ - gcc-mingw-w64-base
+ - binutils-mingw-w64-i686
+ - gcc-mingw-w64-i686
+ - gcc-mingw-w64
+ - gcc-multilib
+ - wine
+ env:
+ - BUILD_DIR=win
+ - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6"
+ - NO_DIRECT_TEST=1
# Test with mingw-w64 (64 bit)
- os: linux
dist: xenial
@@ -138,6 +154,21 @@ matrix:
- BUILD_DIR=win
- CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit"
- NO_DIRECT_TEST=1
+ - os: linux
+ dist: xenial
+ compiler: x86_64-w64-mingw32-gcc
+ addons:
+ apt:
+ packages:
+ - gcc-mingw-w64-base
+ - binutils-mingw-w64-x86-64
+ - gcc-mingw-w64-x86-64
+ - gcc-mingw-w64
+ - wine
+ env:
+ - BUILD_DIR=win
+ - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=6"
+ - NO_DIRECT_TEST=1
before_install:
- export ERROR_ON_FAILURES=1
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 3f8ef3b..4bf7a97 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -2444,19 +2444,16 @@ UnicodeToUtfProc(
const char *srcStart, *srcEnd;
const char *dstEnd, *dstStart;
int result, numChars, charLimit = INT_MAX;
- Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
+ unsigned short ch;
- if (flags & TCL_ENCODING_START) {
- *statePtr = 0;
- }
if (flags & TCL_ENCODING_CHAR_LIMIT) {
charLimit = *dstCharsPtr;
}
result = TCL_OK;
- if ((srcLen % sizeof(Tcl_UniChar)) != 0) {
+ if ((srcLen % sizeof(unsigned short)) != 0) {
result = TCL_CONVERT_MULTIBYTE;
- srcLen /= sizeof(Tcl_UniChar);
- srcLen *= sizeof(Tcl_UniChar);
+ srcLen /= sizeof(unsigned short);
+ srcLen *= sizeof(unsigned short);
}
srcStart = src;
@@ -2473,16 +2470,16 @@ UnicodeToUtfProc(
/*
* Special case for 1-byte utf chars for speed. Make sure we work with
- * Tcl_UniChar-size data.
+ * unsigned short-size data.
*/
- *chPtr = *(Tcl_UniChar *)src;
- if (*chPtr && *chPtr < 0x80) {
- *dst++ = (*chPtr & 0xFF);
+ ch = *(unsigned short *)src;
+ if (ch && ch < 0x80) {
+ *dst++ = (ch & 0xFF);
} else {
- dst += Tcl_UniCharToUtf(*chPtr, dst);
+ dst += Tcl_UniCharToUtf(ch, dst);
}
- src += sizeof(Tcl_UniChar);
+ src += sizeof(unsigned short);
}
*srcReadPtr = src - srcStart;
@@ -2576,20 +2573,30 @@ UtfToUnicodeProc(
#ifdef WORDS_BIGENDIAN
#if TCL_UTF_MAX > 4
- *dst++ = (*chPtr >> 24);
- *dst++ = ((*chPtr >> 16) & 0xFF);
- *dst++ = ((*chPtr >> 8) & 0xFF);
- *dst++ = (*chPtr & 0xFF);
+ if (*chPtr <= 0xFFFF) {
+ *dst++ = (*chPtr >> 8);
+ *dst++ = (*chPtr & 0xFF);
+ } else {
+ *dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
+ *dst++ = (*chPtr & 0xFF);
+ *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
+ *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
+ }
#else
*dst++ = (*chPtr >> 8);
*dst++ = (*chPtr & 0xFF);
#endif
#else
#if TCL_UTF_MAX > 4
- *dst++ = (*chPtr & 0xFF);
- *dst++ = ((*chPtr >> 8) & 0xFF);
- *dst++ = ((*chPtr >> 16) & 0xFF);
- *dst++ = (*chPtr >> 24);
+ if (*chPtr <= 0xFFFF) {
+ *dst++ = (*chPtr & 0xFF);
+ *dst++ = (*chPtr >> 8);
+ } else {
+ *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
+ *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
+ *dst++ = (*chPtr & 0xFF);
+ *dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
+ }
#else
*dst++ = (*chPtr & 0xFF);
*dst++ = (*chPtr >> 8);
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 9380fb2..4b8fa8c 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -59,20 +59,27 @@
* encoding to UTF-8).
*/
-#ifdef UNICODE
+#if defined(UNICODE) && (TCL_UTF_MAX <= 4)
# define NewNativeObj Tcl_NewUnicodeObj
-#else /* !UNICODE */
+#else /* !UNICODE || (TCL_UTF_MAX > 4) */
static inline Tcl_Obj *
NewNativeObj(
- char *string,
+ TCHAR *string,
int length)
{
Tcl_DString ds;
- Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+#ifdef UNICODE
+ if (length > 0) {
+ length *= sizeof(WCHAR);
+ }
+ Tcl_WinTCharToUtf(string, length, &ds);
+#else
+ Tcl_ExternalToUtfDString(NULL, (char *) string, length, &ds);
+#endif
return TclDStringToObj(&ds);
}
-#endif /* !UNICODE */
+#endif /* !UNICODE || (TCL_UTF_MAX > 4) */
/*
* Declarations for various library functions and variables (don't want to
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index fd09ba3..4f2ec5a 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -1997,13 +1997,13 @@ Tcl_UniCharCaseMatch(
Tcl_UniChar startChar, endChar;
uniPattern++;
- ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr);
+ ch1 = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*uniStr) : *uniStr);
uniStr++;
while (1) {
if ((*uniPattern == ']') || (*uniPattern == 0)) {
return 0;
}
- startChar = (nocase ? Tcl_UniCharToLower(*uniPattern)
+ startChar = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*uniPattern)
: *uniPattern);
uniPattern++;
if (*uniPattern == '-') {
@@ -2011,7 +2011,7 @@ Tcl_UniCharCaseMatch(
if (*uniPattern == 0) {
return 0;
}
- endChar = (nocase ? Tcl_UniCharToLower(*uniPattern)
+ endChar = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*uniPattern)
: *uniPattern);
uniPattern++;
if (((startChar <= ch1) && (ch1 <= endChar))
@@ -2190,20 +2190,20 @@ TclUniCharMatch(
Tcl_UniChar ch1, startChar, endChar;
pattern++;
- ch1 = (nocase ? Tcl_UniCharToLower(*string) : *string);
+ ch1 = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*string) : *string);
string++;
while (1) {
if ((*pattern == ']') || (pattern == patternEnd)) {
return 0;
}
- startChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern);
+ startChar = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*pattern) : *pattern);
pattern++;
if (*pattern == '-') {
pattern++;
if (pattern == patternEnd) {
return 0;
}
- endChar = (nocase ? Tcl_UniCharToLower(*pattern)
+ endChar = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*pattern)
: *pattern);
pattern++;
if (((startChar <= ch1) && (ch1 <= endChar))
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 789565b..e6576a5 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2302,7 +2302,7 @@ Tcl_StringCaseMatch(
if (nocase) {
while (*str) {
charLen = TclUtfToUniChar(str, &ch1);
- if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {
+ if (ch2==ch1 || ch2==(Tcl_UniChar)Tcl_UniCharToLower(ch1)) {
break;
}
str += charLen;
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 64a12a3..a80968c 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -4847,7 +4847,7 @@ int
TclZipfs_AppHook(
int *argcPtr, /* Pointer to argc */
#ifdef _WIN32
- TCHAR
+ WCHAR
#else /* !_WIN32 */
char
#endif /* _WIN32 */
diff --git a/tests/encoding.test b/tests/encoding.test
index ab60617..4736928 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -36,7 +36,6 @@ proc runtests {} {
testConstraint testencoding [llength [info commands testencoding]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint teststringbytes [llength [info commands teststringbytes]]
-testConstraint tip389 [expr {[string length \U010000] == 2}]
testConstraint exec [llength [info commands exec]]
testConstraint testgetencpath [llength [info commands testgetencpath]]
@@ -323,16 +322,16 @@ test encoding-15.3 {UtfToUtfProc null character input} teststringbytes {
set z
} c080
-test encoding-16.1 {UnicodeToUtfProc} -constraints tip389 -body {
+test encoding-16.1 {UnicodeToUtfProc} -body {
set val [encoding convertfrom unicode NN]
list $val [format %x [scan $val %c]]
} -result "\u4e4e 4e4e"
-test encoding-16.2 {UnicodeToUtfProc} -constraints tip389 -body {
+test encoding-16.2 {UnicodeToUtfProc} -body {
set val [encoding convertfrom unicode "\xd8\xd8\xdc\xdc"]
list $val [format %x [scan $val %c]]
} -result "\U460dc 460dc"
-test encoding-17.1 {UtfToUnicodeProc} -constraints tip389 -body {
+test encoding-17.1 {UtfToUnicodeProc} -body {
encoding convertto unicode "\U460dc"
} -result "\xd8\xd8\xdc\xdc"
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 6582ee1..bae4bd7 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -931,9 +931,10 @@ TclpMatchInDirectory(
* Match a single file directly.
*/
+ int len;
DWORD attr;
WIN32_FILE_ATTRIBUTE_DATA data;
- const char *str = TclGetString(norm);
+ const char *str = TclGetStringFromObj(norm, &len);
native = Tcl_FSGetNativePath(pathPtr);
@@ -943,7 +944,7 @@ TclpMatchInDirectory(
}
attr = data.dwFileAttributes;
- if (NativeMatchType(WinIsDrive(str,norm->length), attr, native, types)) {
+ if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
}
}
@@ -954,7 +955,7 @@ TclpMatchInDirectory(
WIN32_FIND_DATA data;
const char *dirName; /* UTF-8 dir name, later with pattern
* appended. */
- size_t dirLength;
+ int dirLength;
int matchSpecialDots;
Tcl_DString ds; /* Native encoding of dir, also used
* temporarily for other things. */
@@ -993,8 +994,7 @@ TclpMatchInDirectory(
*/
Tcl_DStringInit(&dsOrig);
- dirName = TclGetString(fileNamePtr);
- dirLength = fileNamePtr->length;
+ dirName = TclGetStringFromObj(fileNamePtr, &dirLength);
Tcl_DStringAppend(&dsOrig, dirName, dirLength);
lastChar = dirName[dirLength -1];
@@ -1464,15 +1464,13 @@ TclpGetUserHome(
}
Tcl_DStringFree(&ds);
} else {
- Tcl_DStringInit(&ds);
- wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
+ wName = Tcl_WinUtfToTChar(domain + 1, -1, &ds);
rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain);
Tcl_DStringFree(&ds);
nameLen = domain - name;
}
if (rc == 0) {
- Tcl_DStringInit(&ds);
- wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
+ wName = Tcl_WinUtfToTChar(name, nameLen, &ds);
while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) {
/*
* user does not exists - if domain was not specified,
@@ -1490,19 +1488,19 @@ TclpGetUserHome(
wHomeDir = uiPtr->usri1_home_dir;
if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
size = lstrlenW(wHomeDir);
- Tcl_UniCharToUtfDString(wHomeDir, size, bufferPtr);
+ Tcl_WinTCharToUtf((TCHAR *) wHomeDir, size * sizeof(WCHAR), bufferPtr);
} else {
/*
* User exists but has no home dir. Return
* "{GetProfilesDirectory}/<user>".
*/
GetProfilesDirectoryW(buf, &size);
- Tcl_UniCharToUtfDString(buf, size-1, bufferPtr);
+ Tcl_WinTCharToUtf(buf, (size-1) * sizeof(WCHAR), bufferPtr);
Tcl_DStringAppend(bufferPtr, "/", 1);
Tcl_DStringAppend(bufferPtr, name, nameLen);
}
result = Tcl_DStringValue(bufferPtr);
- /* be sure we returns normalized path */
+ /* be sure we return normalized path */
for (i = 0; i < size; ++i){
if (result[i] == '\\') result[i] = '/';
}
@@ -2752,14 +2750,15 @@ TclpObjNormalizePath(
* Not the end of the string.
*/
+ int len;
char *path;
Tcl_Obj *tmpPathPtr;
tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
nextCheckpoint);
Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
- path = TclGetString(tmpPathPtr);
- Tcl_SetStringObj(pathPtr, path, tmpPathPtr->length);
+ path = TclGetStringFromObj(tmpPathPtr, &len);
+ Tcl_SetStringObj(pathPtr, path, len);
Tcl_DecrRefCount(tmpPathPtr);
} else {
/*
@@ -2842,8 +2841,9 @@ TclWinVolumeRelativeNormalize(
* also on drive C.
*/
- const char *drive = TclGetString(useThisCwd);
- size_t cwdLen = useThisCwd->length;
+ int cwdLen;
+ const char *drive =
+ TclGetStringFromObj(useThisCwd, &cwdLen);
char drive_cur = path[0];
if (drive_cur >= 'a') {
generated by cgit v0.12 at 2024-11-17 02:05:54 (GMT)