From 86581b5325d887b6e583cd607f1587f9dea918b2 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 13 Mar 2020 13:06:53 +0000 Subject: env.test: added test for windows illustrating bug [8f89e2e059] - loss of multi-byte chars in environment if single-byte system encoding used --- tests/env.test | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/tests/env.test b/tests/env.test index e6ce44d..8eb5612 100644 --- a/tests/env.test +++ b/tests/env.test @@ -217,6 +217,26 @@ test env-2.4 { NAME2=more XYZZY=garbage} +test env-2.5 {different encoding (wide chars)} -constraints {win exec} -setup { + # be sure set of (unicode) environment occurs if single-byte encoding is used: + encodingswitch cp1252 + # german (cp1252) and russian (cp1251) characters together encoded as utf-8: + set val 2d2dc3a4c3b6c3bcc39f2dd182d0b5d181d1822d2d + set env(XYZZY) [encoding convertfrom utf-8 [binary decode hex $val]] + # now switch to utf-8 (to see correct values from test): + encoding system utf-8 +} -body { + exec [interpreter] << [string map [list \$val $val] { + encoding system utf-8; fconfigure stdout -encoding utf-8 + set test [encoding convertfrom utf-8 [binary decode hex $val]] + puts "[expr {$env(XYZZY) eq $test}] \ngot:\t\ + $env(XYZZY) ([binary encode hex [encoding convertto $env(XYZZY)]]) \nexp:\t\ + $test ([binary encode hex [encoding convertto $test]])" + }] +} -cleanup { + encodingrestore + unset -nocomplain val f env(XYZZY) +} -match glob -result {1 *} test env-3.1 { changing environment variables -- cgit v0.12 From 72a735d08976532d328dfd91150df8786a56e5c9 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 13 Mar 2020 13:08:15 +0000 Subject: fix back-ported from tclSE (with several modifications due to conflicts and compat reasons) --- generic/tclEnv.c | 65 +++++++++++++++++++++++++++++++++++++------------------- win/Makefile.in | 5 ++++- win/tclWinInit.c | 16 ++++++++++++-- 3 files changed, 61 insertions(+), 25 deletions(-) diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 487c1a2..9b5f80c 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -34,6 +34,27 @@ static struct { #endif } env; +#if defined(_WIN32) && (defined(_UNICODE) || defined(UNICODE)) +# define tenviron _wenviron +# define tenviron2utfdstr(tenvstr, len, dstr) \ + Tcl_WinTCharToUtf((TCHAR *)tenvstr, len, dstr) +# define utf2tenvirondstr(str, len, dstr) \ + (const char *)Tcl_WinUtfToTChar(str, len, dstr) +# define techar TCHAR +# ifdef USE_PUTENV +# define putenv(env) _wputenv((const wchar_t *)env) +# endif +#else +# define tenviron environ +# define tenviron2utfdstr(tenvstr, len, dstr) \ + Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr) +# define utf2tenvirondstr(str, len, dstr) \ + Tcl_UtfToExternalDString(NULL, str, len, dstr) +# define techar char +#endif + +#define tNTL sizeof(techar) + /* * Declarations for local functions defined in this file: */ @@ -113,16 +134,16 @@ TclSetupEnv( * will hold just the parts to remove. */ - if (environ[0] != NULL) { + if (tenviron[0] != NULL) { int i; Tcl_MutexLock(&envMutex); - for (i = 0; environ[i] != NULL; i++) { + for (i = 0; tenviron[i] != NULL; i++) { Tcl_Obj *obj1, *obj2; const char *p1; char *p2; - p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString); + p1 = tenviron2utfdstr(tenviron[i], -1, &envString); p2 = strchr(p1, '='); if (p2 == NULL) { /* @@ -238,18 +259,18 @@ TclSetEnv( * environment is the one we allocated. [Bug 979640] */ - if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) { + if ((env.ourEnviron != (char *)tenviron) || (length+2 > env.ourEnvironSize)) { char **newEnviron = ckalloc((length + 5) * sizeof(char *)); - memcpy(newEnviron, environ, length * sizeof(char *)); + memcpy(newEnviron, tenviron, length * sizeof(char *)); if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) { ckfree(env.ourEnviron); } - environ = env.ourEnviron = newEnviron; + tenviron = (techar **)(env.ourEnviron = newEnviron); env.ourEnvironSize = length + 5; } index = length; - environ[index + 1] = NULL; + tenviron[index + 1] = NULL; #endif /* USE_PUTENV */ oldValue = NULL; nameLength = strlen(name); @@ -264,7 +285,7 @@ TclSetEnv( * interpreters. */ - oldEnv = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString); + oldEnv = tenviron2utfdstr(tenviron[index], -1, &envString); if (strcmp(value, oldEnv + (length + 1)) == 0) { Tcl_DStringFree(&envString); Tcl_MutexUnlock(&envMutex); @@ -272,7 +293,7 @@ TclSetEnv( } Tcl_DStringFree(&envString); - oldValue = environ[index]; + oldValue = (char *)tenviron[index]; nameLength = (unsigned) length; } @@ -287,14 +308,14 @@ TclSetEnv( memcpy(p, name, nameLength); p[nameLength] = '='; memcpy(p+nameLength+1, value, valueLength+1); - p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString); + p2 = utf2tenvirondstr(p, -1, &envString); /* * Copy the native string to heap memory. */ - p = ckrealloc(p, Tcl_DStringLength(&envString) + 1); - memcpy(p, p2, (unsigned) Tcl_DStringLength(&envString) + 1); + p = ckrealloc(p, Tcl_DStringLength(&envString) + tNTL); + memcpy(p, p2, (unsigned) Tcl_DStringLength(&envString) + tNTL); Tcl_DStringFree(&envString); #ifdef USE_PUTENV @@ -305,7 +326,7 @@ TclSetEnv( putenv(p); index = TclpFindVariable(name, &length); #else - environ[index] = p; + tenviron[index] = (techar *)p; #endif /* USE_PUTENV */ /* @@ -314,7 +335,7 @@ TclSetEnv( * string in the cache. */ - if ((index != -1) && (environ[index] == p)) { + if ((index != -1) && (tenviron[index] == (techar *)p)) { ReplaceString(oldValue, p); #ifdef HAVE_PUTENV_THAT_COPIES } else { @@ -378,7 +399,7 @@ Tcl_PutEnv( * name and value parts, and call TclSetEnv to do all of the real work. */ - name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString); + name = tenviron2utfdstr(assignment, -1, &nameString); value = strchr(name, '='); if ((value != NULL) && (value != name)) { @@ -440,7 +461,7 @@ TclUnsetEnv( * Remember the old value so we can free it if Tcl created the string. */ - oldValue = environ[index]; + oldValue = (char *)tenviron[index]; /* * Update the system environment. This must be done before we update the @@ -464,10 +485,10 @@ TclUnsetEnv( string[length] = '\0'; #endif /* _WIN32 */ - Tcl_UtfToExternalDString(NULL, string, -1, &envString); - string = ckrealloc(string, Tcl_DStringLength(&envString) + 1); + utf2tenvirondstr(string, -1, &envString); + string = ckrealloc(string, Tcl_DStringLength(&envString) + tNTL); memcpy(string, Tcl_DStringValue(&envString), - (unsigned) Tcl_DStringLength(&envString)+1); + (unsigned) Tcl_DStringLength(&envString) + tNTL); Tcl_DStringFree(&envString); putenv(string); @@ -478,7 +499,7 @@ TclUnsetEnv( * string in the cache. */ - if (environ[index] == string) { + if (tenviron[index] == (techar *)string) { ReplaceString(oldValue, string); #ifdef HAVE_PUTENV_THAT_COPIES } else { @@ -490,7 +511,7 @@ TclUnsetEnv( #endif /* HAVE_PUTENV_THAT_COPIES */ } #else /* !USE_PUTENV_FOR_UNSET */ - for (envPtr = environ+index+1; ; envPtr++) { + for (envPtr = (char *)(tenviron+index+1); ; envPtr++) { envPtr[-1] = *envPtr; if (*envPtr == NULL) { break; @@ -539,7 +560,7 @@ TclGetEnv( if (index != -1) { Tcl_DString envStr; - result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr); + result = tenviron2utfdstr(tenviron[index], -1, &envStr); result += length; if (*result == '=') { result++; diff --git a/win/Makefile.in b/win/Makefile.in index 70a6909..667a0be 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -528,11 +528,14 @@ ${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE} # Special case object targets +tclEnv.${OBJEXT}: tclEnv.c + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) + tclTestMain.${OBJEXT}: tclAppInit.c $(CC) -c $(CC_SWITCHES) -DTCL_TEST -DUNICODE -D_UNICODE $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) tclWinInit.${OBJEXT}: tclWinInit.c - $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME) tclWinPipe.${OBJEXT}: tclWinPipe.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME) diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 6ca6a46..2d26482 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -683,6 +683,16 @@ TclpSetVariables( *---------------------------------------------------------------------- */ +#if defined(_WIN32) && (defined(_UNICODE) || defined(UNICODE)) +# define tenviron _wenviron +# define tenviron2utfdstr(tenvstr, len, dstr) \ + Tcl_WinTCharToUtf((TCHAR *)tenvstr, len, dstr) +#else +# define tenviron environ +# define tenviron2utfdstr(tenvstr, len, dstr) \ + Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr) +#endif + int TclpFindVariable( const char *name, /* Name of desired environment variable @@ -707,14 +717,16 @@ TclpFindVariable( Tcl_UtfToUpper(nameUpper); Tcl_DStringInit(&envString); - for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { + for (i = 0, env = (const char *)tenviron[i]; + env != NULL; + i++, env = (const char *)tenviron[i]) { /* * Chop the env string off after the equal sign, then Convert the name * to all upper case, so we do not have to convert all the characters * after the equal sign. */ - envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); + envUpper = tenviron2utfdstr(env, -1, &envString); p1 = strchr(envUpper, '='); if (p1 == NULL) { continue; -- cgit v0.12