From 42e81a69ad3d6b7b5a58d55b4d32de32827bfa9a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 7 Mar 2019 22:02:41 +0000 Subject: Fixes for TCL_UTF_MAX=6, (gcc compiler warnings). Also make everything work on win32/win64. Patch adapted from Androwish (thanks, Werner!) --- .travis.yml | 31 +++++++++++++++++++++++++++++++ generic/tclEncoding.c | 49 ++++++++++++++++++++++++++++--------------------- generic/tclMain.c | 17 ++++++++++++----- generic/tclUtf.c | 12 ++++++------ generic/tclUtil.c | 2 +- generic/tclZipfs.c | 2 +- tests/encoding.test | 7 +++---- win/tclWinFile.c | 32 ++++++++++++++++---------------- 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}/". */ 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') { -- cgit v0.12 From eb0e31e945c4147ee2beef42af28636e9c3c9f59 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Mar 2019 19:51:26 +0000 Subject: Code cleanup: less (size_t) casts --- generic/regcomp.c | 17 ++++++++--------- generic/regexec.c | 8 ++++---- 2 files changed, 12 insertions(+), 13 deletions(-) diff --git a/generic/regcomp.c b/generic/regcomp.c index 58d55fb..7735d8b 100644 --- a/generic/regcomp.c +++ b/generic/regcomp.c @@ -210,7 +210,7 @@ struct vars { int lexcon; /* lexical context type (see lex.c) */ int nsubexp; /* subexpression count */ struct subre **subs; /* subRE pointer vector */ - size_t nsubs; /* length of vector */ + int nsubs; /* length of vector */ struct subre *sub10[10]; /* initial vector, enough for most */ struct nfa *nfa; /* the NFA */ struct colormap *cm; /* character color map */ @@ -287,8 +287,7 @@ compile( { AllocVars(v); struct guts *g; - int i; - size_t j; + int i, j; FILE *debug = (flags®_PROGRESS) ? stdout : NULL; #define CNOERR() { if (ISERR()) return freev(v, v->err); } @@ -477,10 +476,10 @@ moresubs( int wanted) /* want enough room for this one */ { struct subre **p; - size_t n; + int n; - assert(wanted > 0 && (size_t)wanted >= v->nsubs); - n = (size_t)wanted * 3 / 2 + 1; + assert(wanted > 0 && wanted >= v->nsubs); + n = wanted * 3 / 2 + 1; if (v->subs == v->sub10) { p = (struct subre **) MALLOC(n * sizeof(struct subre *)); if (p != NULL) { @@ -499,7 +498,7 @@ moresubs( *p = NULL; } assert(v->nsubs == n); - assert((size_t)wanted < v->nsubs); + assert(wanted < v->nsubs); } /* @@ -954,10 +953,10 @@ parseqatom( if (cap) { v->nsubexp++; subno = v->nsubexp; - if ((size_t)subno >= v->nsubs) { + if (subno >= v->nsubs) { moresubs(v, subno); } - assert((size_t)subno < v->nsubs); + assert(subno < v->nsubs); } else { atomtype = PLAIN; /* something that's not '(' */ } diff --git a/generic/regexec.c b/generic/regexec.c index 128d439..c57f42c 100644 --- a/generic/regexec.c +++ b/generic/regexec.c @@ -172,8 +172,8 @@ exec( { AllocVars(v); int st, backref; - size_t n; - size_t i; + int n; + int i; #define LOCALMAT 20 regmatch_t mat[LOCALMAT]; #define LOCALDFAS 40 @@ -236,7 +236,7 @@ exec( v->stop = (chr *)string + len; v->err = 0; assert(v->g->ntree >= 0); - n = (size_t) v->g->ntree; + n = v->g->ntree; if (n <= LOCALDFAS) v->subdfas = subdfas; else @@ -278,7 +278,7 @@ exec( if (v->pmatch != pmatch && v->pmatch != mat) { FREE(v->pmatch); } - n = (size_t) v->g->ntree; + n = v->g->ntree; for (i = 0; i < n; i++) { if (v->subdfas[i] != NULL) freeDFA(v->subdfas[i]); -- cgit v0.12