From 8e89253fad1900e36e3eb5351cc611ecb2261efd Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Sat, 12 Apr 2025 12:03:19 +0000 Subject: Start on TIP 716 implementation --- win/tclWinInit.c | 79 +++++++++++++++++++++++++++++++++++++++++++++-- win/tclsh.exe.manifest.in | 4 --- 2 files changed, 76 insertions(+), 7 deletions(-) diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 141aff1..57bd63f 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -63,6 +63,62 @@ static ProcessGlobalValue defaultLibraryDir = {0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL}; static ProcessGlobalValue sourceLibraryDir = {0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL}; + + +/* + * TclpGetWindowsVersionOnce -- + * + * Callback to retrieve Windows version information. To be invoked only + * through InitOnceExecuteOnce for thread safety. + * + * Results: + * None. + */ +static BOOL CALLBACK TclpGetWindowsVersionOnce( + TCL_UNUSED(PINIT_ONCE), + TCL_UNUSED(PVOID), + PVOID *lpContext) +{ + typedef int(__stdcall getVersionProc)(void *); + static OSVERSIONINFOW osInfo; + + /* + * GetVersionExW will not return the "real" Windows version so use + * RtlGetVersion if available and falling back. + */ + HMODULE handle = GetModuleHandleW(L"NTDLL"); + getVersionProc *getVersion = + (getVersionProc *)(void *)GetProcAddress(handle, "RtlGetVersion"); + + osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); + if (getVersion == NULL || getVersion(&osInfo)) { + if (!GetVersionExW(&osInfo)) { + /* Should never happen but ...*/ + return FALSE; + } + } + *lpContext = (LPVOID)&osInfo; + return TRUE; +} + +/* + * TclpGetWindowsVersion -- + * + * Returns a pointer to the OSVERSIONINFOW structure containing the + * version information for the current Windows version. + * + * Results: + * Pointer to OSVERSIONINFOW structure. + */ +static const OSVERSIONINFOW *TclpGetWindowsVersion(void) +{ + static INIT_ONCE osInfoOnce = INIT_ONCE_STATIC_INIT; + OSVERSIONINFOW *osInfoPtr = NULL; + BOOL result = InitOnceExecuteOnce( + &osInfoOnce, TclpGetWindowsVersionOnce, NULL, &osInfoPtr); + return result ? osInfoPtr : NULL; +} + /* *--------------------------------------------------------------------------- @@ -398,7 +454,7 @@ TclpSetInitialEncodings(void) } const char * -Tcl_GetEncodingNameFromEnvironment( +Tcl_GetEncodingNameForUser( Tcl_DString *bufPtr) { UINT acp = GetACP(); @@ -414,7 +470,24 @@ Tcl_GetEncodingNameFromEnvironment( } return Tcl_DStringValue(bufPtr); } - + +const char * +Tcl_GetEncodingNameFromEnvironment( + Tcl_DString *bufPtr) +{ + OSVERSIONINFOW *osInfoPtr = TclpGetWindowsVersion(); + /* + * TIP 716 - for Build 18362 or higher, force utf-8. Note Windows build + * numbers always increase, so no need to check major / minor versions. + */ + if (osInfoPtr && osInfoPtr->dwBuildNumber >= 18362) { + Tcl_DStringInit(bufPtr); + Tcl_DStringAppend(bufPtr, "utf-8", 5); + return Tcl_DStringValue(bufPtr); + } + return Tcl_GetEncodingNameForUser(bufPtr); +} + const char * TclpGetUserName( Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with @@ -435,7 +508,7 @@ TclpGetUserName( } return Tcl_DStringValue(bufferPtr); } - + /* *--------------------------------------------------------------------------- * diff --git a/win/tclsh.exe.manifest.in b/win/tclsh.exe.manifest.in index dc652e6..dd8a7c5 100644 --- a/win/tclsh.exe.manifest.in +++ b/win/tclsh.exe.manifest.in @@ -35,10 +35,6 @@ xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings"> true - - UTF-8 - -- cgit v0.12 From ad696be16d8ed9b6bcd94cb2e015cef73177a928 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Sat, 12 Apr 2025 15:11:18 +0000 Subject: Added encoding user command --- generic/tclCmdAH.c | 32 ++++++++++++++++++++++++++++++++ generic/tclInt.h | 3 ++- 2 files changed, 34 insertions(+), 1 deletion(-) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index ea98a83..877b3bb 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -53,6 +53,7 @@ static Tcl_ObjCmdProc EncodingDirsObjCmd; static Tcl_ObjCmdProc EncodingNamesObjCmd; static Tcl_ObjCmdProc EncodingProfilesObjCmd; static Tcl_ObjCmdProc EncodingSystemObjCmd; +static Tcl_ObjCmdProc EncodingUserObjCmd; static inline int ForeachAssignments(Tcl_Interp *interp, struct ForeachState *statePtr); static inline void ForeachCleanup(Tcl_Interp *interp, @@ -394,6 +395,7 @@ TclInitEncodingCmd( {"names", EncodingNamesObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"profiles", EncodingProfilesObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"system", EncodingSystemObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, + {"user", EncodingUserObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1}, {NULL, NULL, NULL, NULL, NULL, 0} }; @@ -829,6 +831,36 @@ EncodingSystemObjCmd( } /* + *----------------------------------------------------------------------------- + * + * EncodingUserObjCmd -- + * + * This command retrieves the encoding as per the user settings. + * + * Results: + * Returns a standard Tcl result + * + *----------------------------------------------------------------------------- + */ + +int +EncodingUserObjCmd( + TCL_UNUSED(void *), + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Number of command line args */ + Tcl_Obj* const objv[]) /* Vector of command line args */ +{ + if (objc > 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + Tcl_DString ds; + Tcl_GetEncodingNameForUser(&ds); + Tcl_DStringResult(interp, &ds); + return TCL_OK; +} + +/* *---------------------------------------------------------------------- * * Tcl_ErrorObjCmd -- diff --git a/generic/tclInt.h b/generic/tclInt.h index 963e850..2dbbc05 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3122,7 +3122,8 @@ MODULE_SCOPE int TclEncodingProfileNameToId(Tcl_Interp *interp, MODULE_SCOPE const char *TclEncodingProfileIdToName(Tcl_Interp *interp, int profileId); MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); - +/* TIP 716 - MODULE_SCOPE for 9.0.2. Will be public in 9.1 */ +MODULE_SCOPE const char *Tcl_GetEncodingNameForUser(Tcl_DString *bufPtr); /* * TIP #233 (Virtualized Time) * Data for the time hooks, if any. -- cgit v0.12 From 6beacbba8a6d92cd22062b84844b6cc2474ad23b Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Sat, 12 Apr 2025 16:57:22 +0000 Subject: Added -encoding option to exec --- generic/tclIOCmd.c | 44 +++++++++++++++++++++++++++++++++----------- tests/cmdAH.test | 2 +- tests/exec.test | 2 +- 3 files changed, 35 insertions(+), 13 deletions(-) diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 712447b..aefefee 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -910,11 +910,12 @@ Tcl_ExecObjCmd( int argc, background, i, index, keepNewline, result, skip, ignoreStderr; Tcl_Size length; static const char *const options[] = { - "-ignorestderr", "-keepnewline", "--", NULL + "-ignorestderr", "-keepnewline", "-encoding", "--", NULL }; enum execOptionsEnum { - EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST + EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_ENCODING, EXEC_LAST }; + Tcl_Obj *encodingObj = NULL; /* * Check for any leading option arguments. @@ -931,12 +932,24 @@ Tcl_ExecObjCmd( TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } - if (index == EXEC_KEEPNEWLINE) { + if (index == EXEC_LAST) { + skip++; + break; + } + switch (index) { + case EXEC_KEEPNEWLINE: keepNewline = 1; - } else if (index == EXEC_IGNORESTDERR) { + break; + case EXEC_IGNORESTDERR: ignoreStderr = 1; - } else { - skip++; + break; + case EXEC_ENCODING: + if (++skip >= objc) { + Tcl_SetResult(interp, "No value given for option -encoding.", + TCL_STATIC); + return TCL_ERROR; + } + encodingObj = objv[skip]; break; } } @@ -986,11 +999,6 @@ Tcl_ExecObjCmd( return TCL_ERROR; } - /* Bug [0f1ddc0df7] - encoding errors - use replace profile */ - if (Tcl_SetChannelOption(NULL, chan, "-profile", "replace") != TCL_OK) { - return TCL_ERROR; - } - if (background) { /* * Store the list of PIDs from the pipeline in interp's result and @@ -1004,6 +1012,20 @@ Tcl_ExecObjCmd( return TCL_OK; } + /* Bug [0f1ddc0df7] - encoding errors - use replace profile */ + if (Tcl_SetChannelOption(interp, chan, "-profile", "replace") != TCL_OK) { + return TCL_ERROR; + } + + /* TIP 716 */ + if (encodingObj) { + if (Tcl_SetChannelOption( + interp, chan, "-encoding", Tcl_GetString(encodingObj)) != + TCL_OK) { + return TCL_ERROR; + } + } + TclNewObj(resultPtr); if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) { if (Tcl_ReadChars(chan, resultPtr, -1, 0) == TCL_IO_FAILURE) { diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 028fbf1..1e64d0f 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -323,7 +323,7 @@ test cmdAH-4.1.1 {encoding} -returnCodes error -body { } -result {wrong # args: should be "encoding subcommand ?arg ...?"} test cmdAH-4.1.2 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding foo -} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, profiles, or system} +} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, profiles, system, or user} # # encoding system 4.2.* diff --git a/tests/exec.test b/tests/exec.test index 141df07..26fe802 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -568,7 +568,7 @@ test exec-14.2 {-keepnewline switch} -constraints {exec} -body { } -returnCodes error -result {wrong # args: should be "exec ?-option ...? arg ?arg ...?"} test exec-14.3 {unknown switch} -constraints {exec} -body { exec -gorp -} -returnCodes error -result {bad option "-gorp": must be -ignorestderr, -keepnewline, or --} +} -returnCodes error -result {bad option "-gorp": must be -ignorestderr, -keepnewline, -encoding, or --} test exec-14.4 {-- switch} -constraints {exec notValgrind} -body { exec -- -gorp } -returnCodes error -result {couldn't execute "-gorp": no such file or directory} -- cgit v0.12 From 2c5e45746fb246b6c591f67c86edb7a19065c2e1 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Mon, 14 Apr 2025 16:15:05 +0000 Subject: Fix Unix build. Add basic tests --- generic/tclInt.h | 8 ++++++++ tests/encoding.test | 28 +++++++++++++++++++++++++++- tests/exec.test | 14 ++++++++++++++ tests/tcltests.tcl | 19 +++++++++++++++++++ 4 files changed, 68 insertions(+), 1 deletion(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 2dbbc05..948c522 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3123,7 +3123,15 @@ MODULE_SCOPE const char *TclEncodingProfileIdToName(Tcl_Interp *interp, int profileId); MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); /* TIP 716 - MODULE_SCOPE for 9.0.2. Will be public in 9.1 */ +#ifdef _WIN32 MODULE_SCOPE const char *Tcl_GetEncodingNameForUser(Tcl_DString *bufPtr); +#else +static inline const char * +Tcl_GetEncodingNameForUser(Tcl_DString *bufPtr) +{ + return Tcl_GetEncodingNameFromEnvironment(bufPtr); +} +#endif /* * TIP #233 (Virtualized Time) * Data for the time hooks, if any. diff --git a/tests/encoding.test b/tests/encoding.test index a754f72..c998e13 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -12,7 +12,7 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } - +source [file join [file dirname [info script]] tcltests.tcl] namespace eval ::tcl::test::encoding { variable x @@ -1150,6 +1150,32 @@ test encoding-30.3 {encoding convertfrom large strings > 4GB} -constraints { list [string length [set s [string repeat A 0x100000000]]] [string equal $s [encoding convertfrom ascii $s]] } -result {4294967296 1} +# TIP 716 tests +tcltests::testnumargs "encoding user" "" "" +test encoding-31.0 {encoding user} -body { + encoding user +} -result [expr {$::tcl_platform(platform) eq "windows" ? [tcltests::windowscodepage] : [encoding system]}] + +test encoding-31.1 {encoding system does not change encoding user} -setup { + set system [encoding system] + set user [encoding user] +} -body { + encoding system ascii + list [encoding system] [string equal [encoding user] $user] +} -cleanup { + encoding system $system + unset system + unset user +} -result {ascii 1} + +test encoding-31.2 {encoding system on newer Windows always returns utf-8} -body { + string equal [encoding system] \ + [expr { + [tcltests::windowsbuildnumber] > 18362 ? + "utf-8" : [tcltests::windowscodepage] + }] +} -constraints win -result 1 + test encoding-bug-6a3e2cb0f0-1 {Bug [6a3e2cb0f0] - invalid bytes in escape encodings} -body { encoding convertfrom -profile tcl8 iso2022-jp x\x1B\x7Aaby } -result x\uFFFDy diff --git a/tests/exec.test b/tests/exec.test index 26fe802..b184d24 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -48,6 +48,11 @@ set path(echo2) [makeFile { puts stderr [lindex $argv 1] exit } echo2] +set path(echobin) [makeFile { + fconfigure stdout -translation binary + puts -nonewline [binary decode hex [join $argv ""]] + exit +} echobin] set path(cat) [makeFile { if {$argv eq ""} { set argv - @@ -750,6 +755,15 @@ test exec-21.2 {exec encoding mismatch on stderr} -setup { list [catch {exec [info nameofexecutable] $path(script)} r] $r } -result [list 1 a\uFFFDb] +# TIP 716 -encoding option +test exec-22.0 {exec -encoding} -body { + set enc [expr {[encoding system] eq "utf-8" ? "iso2022-jp" : "utf-8"}] + exec -encoding $enc -- [interpreter] $path(echobin) [binary encode hex [encoding convertto $enc \u4e4e\u68d9]] +} -result \u4e4e\u68d9 +test exec-22.1 {exec -encoding invalid encoding} -body { + exec -encoding nosuchencoding -- [interpreter] $path(echobin) abc +} -result {unknown encoding "nosuchencoding"} -returnCodes error + test exec-bug-4f0b5767ac {exec App Execution Alias} -constraints haveWinget -body { exec winget --info } -result "Windows Package Manager*" -match glob diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl index 43f0f60..73080f0 100644 --- a/tests/tcltests.tcl +++ b/tests/tcltests.tcl @@ -116,6 +116,25 @@ namespace eval ::tcltests { -result $message -returnCodes error \ {*}$args } + + # Return Windows version as FULLVERSION MAJOR MINOR BUILD REVISION + if {$::tcl_platform(platform) eq "windows"} { + proc windowsversion {} { + set ver [regexp -inline {(\d+).(\d+).(\d+).(\d+)} [exec {*}[auto_execok ver]]] + proc windowsversion {} [list return $ver] + return [windowsversion] + } + proc windowsbuildnumber {} { + return [lindex [windowsversion] 3] + } + proc windowscodepage {} { + # Note we cannot use result of chcp because that returns OEM code page. + package require registry + set cp [registry get HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Control\\Nls\\CodePage ACP] + proc windowscodepage {} "return cp$cp" + return [windowscodepage] + } + } } init -- cgit v0.12 From 8e247cc6a3b3360c6f0b2d26f722529376e6d5af Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 28 Apr 2025 07:37:06 +0000 Subject: Attempt to fix cmdAH test failures. Doesn't work. --- win/tclWinTest.c | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 72e1e83..01a02a5 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -43,7 +43,7 @@ static Tcl_ObjCmdProc TestvolumetypeCmd; static Tcl_ObjCmdProc TestwinclockCmd; static Tcl_ObjCmdProc TestwinsleepCmd; static Tcl_ObjCmdProc TestExceptionCmd; -static int TestplatformChmod(const char *nativePath, int pmode); +static int TestplatformChmod(const char *nativePath, int pmode, Tcl_Encoding encoding); static Tcl_ObjCmdProc TestchmodCmd; /* @@ -398,7 +398,8 @@ TestExceptionCmd( static int TestplatformChmod( const char *nativePath, - int pmode) + int pmode, + Tcl_Encoding encoding) { /* * Note FILE_DELETE_CHILD missing from dirWriteMask because we do @@ -444,7 +445,7 @@ TestplatformChmod( res = -1; /* Assume failure */ Tcl_DStringInit(&ds); - Tcl_UtfToExternalDString(NULL, nativePath, -1, &ds); + Tcl_UtfToExternalDString(encoding, nativePath, -1, &ds); attr = GetFileAttributesA(Tcl_DStringValue(&ds)); if (attr == 0xFFFFFFFF) { @@ -641,6 +642,7 @@ TestchmodCmd( Tcl_Obj *const * objv) /* Parameter vector */ { int i, mode; + Tcl_DString ds; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?"); @@ -651,6 +653,9 @@ TestchmodCmd( return TCL_ERROR; } + Tcl_Encoding encoding = Tcl_GetEncoding(interp, Tcl_GetEncodingNameForUser(&ds)); + Tcl_DStringFree(&ds); + for (i = 2; i < objc; i++) { Tcl_DString buffer; const char *translated; @@ -659,7 +664,7 @@ TestchmodCmd( if (translated == NULL) { return TCL_ERROR; } - if (TestplatformChmod(translated, mode) != 0) { + if (TestplatformChmod(translated, mode, encoding) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), (char *)NULL); return TCL_ERROR; -- cgit v0.12 From 67681ec324afbb26bfed68799c99ffb0eef0c385 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Mon, 28 Apr 2025 11:30:02 +0000 Subject: Fix cmdAH tests. See comments below. Tcl_GetEncodingForUser will not be available until 9.1 for stubs compatibility. In any case, as a rule, wide char API's should be used in code and tests to avoid the exact kind of problems we are currently trying to solve with code pages. --- win/tclWinTest.c | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 01a02a5..005fb37 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -43,7 +43,7 @@ static Tcl_ObjCmdProc TestvolumetypeCmd; static Tcl_ObjCmdProc TestwinclockCmd; static Tcl_ObjCmdProc TestwinsleepCmd; static Tcl_ObjCmdProc TestExceptionCmd; -static int TestplatformChmod(const char *nativePath, int pmode, Tcl_Encoding encoding); +static int TestplatformChmod(const char *nativePath, int pmode); static Tcl_ObjCmdProc TestchmodCmd; /* @@ -398,8 +398,7 @@ TestExceptionCmd( static int TestplatformChmod( const char *nativePath, - int pmode, - Tcl_Encoding encoding) + int pmode) { /* * Note FILE_DELETE_CHILD missing from dirWriteMask because we do @@ -445,9 +444,9 @@ TestplatformChmod( res = -1; /* Assume failure */ Tcl_DStringInit(&ds); - Tcl_UtfToExternalDString(encoding, nativePath, -1, &ds); + Tcl_UtfToChar16DString(nativePath, -1, &ds); - attr = GetFileAttributesA(Tcl_DStringValue(&ds)); + attr = GetFileAttributesW((WCHAR *)Tcl_DStringValue(&ds)); if (attr == 0xFFFFFFFF) { goto done; /* Not found */ } @@ -587,7 +586,7 @@ TestplatformChmod( * to remove inherited ACL (we need to overwrite the default ACL's in this case) */ - if (SetNamedSecurityInfoA((LPSTR)Tcl_DStringValue(&ds), SE_FILE_OBJECT, + if (SetNamedSecurityInfoW((LPWSTR)Tcl_DStringValue(&ds), SE_FILE_OBJECT, DACL_SECURITY_INFORMATION | PROTECTED_DACL_SECURITY_INFORMATION, NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) { res = 0; @@ -609,7 +608,7 @@ TestplatformChmod( if (res == 0) { /* Run normal chmod command */ - res = _chmod(Tcl_DStringValue(&ds), pmode); + res = _wchmod((WCHAR*)Tcl_DStringValue(&ds), pmode); } Tcl_DStringFree(&ds); return res; @@ -642,7 +641,6 @@ TestchmodCmd( Tcl_Obj *const * objv) /* Parameter vector */ { int i, mode; - Tcl_DString ds; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?"); @@ -653,9 +651,6 @@ TestchmodCmd( return TCL_ERROR; } - Tcl_Encoding encoding = Tcl_GetEncoding(interp, Tcl_GetEncodingNameForUser(&ds)); - Tcl_DStringFree(&ds); - for (i = 2; i < objc; i++) { Tcl_DString buffer; const char *translated; @@ -664,7 +659,7 @@ TestchmodCmd( if (translated == NULL) { return TCL_ERROR; } - if (TestplatformChmod(translated, mode, encoding) != 0) { + if (TestplatformChmod(translated, mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), (char *)NULL); return TCL_ERROR; -- cgit v0.12 From e9fe9e755c90c3dbc263bea727a9b83051650ca5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 29 Apr 2025 08:51:25 +0000 Subject: Unbreak (gcc) build --- win/tclWinInit.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 57bd63f..35ce207 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -115,7 +115,7 @@ static const OSVERSIONINFOW *TclpGetWindowsVersion(void) static INIT_ONCE osInfoOnce = INIT_ONCE_STATIC_INIT; OSVERSIONINFOW *osInfoPtr = NULL; BOOL result = InitOnceExecuteOnce( - &osInfoOnce, TclpGetWindowsVersionOnce, NULL, &osInfoPtr); + &osInfoOnce, TclpGetWindowsVersionOnce, NULL, (LPVOID *)&osInfoPtr); return result ? osInfoPtr : NULL; } @@ -475,7 +475,7 @@ const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr) { - OSVERSIONINFOW *osInfoPtr = TclpGetWindowsVersion(); + const OSVERSIONINFOW *osInfoPtr = TclpGetWindowsVersion(); /* * TIP 716 - for Build 18362 or higher, force utf-8. Note Windows build * numbers always increase, so no need to check major / minor versions. -- cgit v0.12 From 261e788b4b30a552d9623a1dc68502e64af2cf51 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Wed, 21 May 2025 00:53:05 +0000 Subject: Update docs --- doc/encoding.n | 8 ++++++++ doc/exec.n | 6 ++++++ 2 files changed, 14 insertions(+) diff --git a/doc/encoding.n b/doc/encoding.n index 43da934..7789778 100644 --- a/doc/encoding.n +++ b/doc/encoding.n @@ -104,6 +104,14 @@ Returns a list of the names of encoding profiles. See \fBPROFILES\fR below. Set the system encoding to \fIencoding\fR. If \fIencoding\fR is omitted then the command returns the current system encoding. The system encoding is used whenever Tcl passes strings to system calls. +.TP +\fBencoding user\fR +.VS TIP716 +Returns the name of encoding as per the user's preferences. On Windows +systems, this is based on the user's code page settings in the registry. +On other platforms, the returned value is the same as returned by +\fBencoding system\fR. +.VE TIP716 .\" Do not put .VS on whole section as that messes up the bullet list alignment .SH PROFILES .PP diff --git a/doc/exec.n b/doc/exec.n index 4992922..d36c5ab 100644 --- a/doc/exec.n +++ b/doc/exec.n @@ -33,6 +33,12 @@ of the pipeline specification. The following switches are currently supported: .\" OPTION: -ignorestderr .TP 13 +\fB\-encoding \fIencodingName\fR +. +Specifies the name of the encoding to use to decode the output of the first +subprocess. Defaults to that returned by the \fBencoding system\fR command. +.\" OPTION: -ignorestderr +.TP 13 \fB\-ignorestderr\fR . Stops the \fBexec\fR command from treating the output of messages to the -- cgit v0.12 From 86256cad5d7ee285b7afb83c888b6d645a8327d4 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 23 May 2025 02:18:55 +0000 Subject: Fix [c776eb586d]. Read codepage from registry (reported by Jan) --- win/tclWinInit.c | 141 +++++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 126 insertions(+), 15 deletions(-) diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 8ff0e0e..23aad3e 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -12,6 +12,7 @@ */ #include "tclWinInt.h" +#include #include #include #include @@ -35,6 +36,12 @@ typedef struct { WORD wReserved; } OemId; +typedef struct { + Tcl_Encoding userEncoding; +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; + /* * The following arrays contain the human readable strings for the * processor values. @@ -119,7 +126,74 @@ static const OSVERSIONINFOW *TclpGetWindowsVersion(void) return result ? osInfoPtr : NULL; } - +/* + * TclpGetCodePageOnce -- + * + * Callback to retrieve user code page. To be invoked only + * through InitOnceExecuteOnce for thread safety. + * + * Results: + * None. + */ +static BOOL CALLBACK +TclpGetCodePageOnce( + TCL_UNUSED(PINIT_ONCE), + TCL_UNUSED(PVOID), + PVOID *lpContext) +{ + static char codePage[20]; + codePage[0] = 'c'; + codePage[1] = 'p'; + DWORD size = sizeof(codePage) - 2; + + /* + * When retrieving code page from registry, + * - use ANSI API's since all values will be ASCII and saves conversion + * - use RegGetValue, not RegQueryValueEx, since the latter does not + * guarantee the value is null terminated + * - added bonus, RegGetValue is much more convenient to use + */ + if (RegGetValueA(HKEY_LOCAL_MACHINE, + "SYSTEM\\CurrentControlSet\\Control\\Nls\\CodePage", + "ACP", RRF_RT_REG_SZ, NULL, codePage+2, + &size) != ERROR_SUCCESS) { + /* On failure, fallback to GetACP() */ + UINT acp = GetACP(); + snprintf(codePage, sizeof(codePage), "cp%u", acp); + } + if (strcmp(codePage, "cp65001") == 0) { + strcpy(codePage, "utf-8"); + } + *lpContext = (LPVOID)&codePage[0]; + return TRUE; +} + +/* + * TclpGetCodePage -- + * + * Returns a pointer to the string identifying the user code page. + * + * For consistency with Windows, which caches the code page at program + * startup, the code page is not updated even if the value in the registry + * changes. (This is similar to environment variables.) + */ +static const char * +TclpGetCodePage(void) +{ + static INIT_ONCE codePageOnce = INIT_ONCE_STATIC_INIT; + const char *codePagePtr = NULL; + BOOL result = InitOnceExecuteOnce( + &codePageOnce, TclpGetCodePageOnce, NULL, (LPVOID *)&codePagePtr); +#ifdef NDEBUG + (void) result; /* Keep gcc unused variable quiet */ +#else + assert(result == TRUE); +#endif + assert(codePagePtr != NULL); + return codePagePtr; +} + + /* *--------------------------------------------------------------------------- * @@ -162,8 +236,11 @@ TclpInitPlatform(void) TclWinInit(GetModuleHandleW(NULL)); #endif + + /* Initialize code page once at startup, will not be updated */ + (void)TclpGetCodePage(); } - + /* *------------------------------------------------------------------------- * @@ -453,21 +530,54 @@ TclpSetInitialEncodings(void) Tcl_DStringFree(&encodingName); } -const char * -Tcl_GetEncodingNameForUser( - Tcl_DString *bufPtr) +#if 0 + +/* + *--------------------------------------------------------------------------- + * + * TclpGetEncodingForUser -- + * + * Returns the Tcl_Encoding corresponding to the user code page. + * + * Results: + * A Tcl_Encoding value or NULL if the encoding cannot be found or + * if Tcl does not support the encoding. + * + * Side effects: + * The encoding is cached in the thread local storage. + *--------------------------------------------------------------------------- + */ +Tcl_Encoding +TclpGetEncodingForUser(Tcl_Interp *interp) { - UINT acp = GetACP(); + /* + * In keeping with Windows, the encoding will not be updated if the + * registry value changes so we never need to update it once + * successfully retrieved. + */ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + if (tsdPtr->userEncoding == NULL) { + tsdPtr->userEncoding = + Tcl_GetEncoding(interp, TclpGetCodePage()); + } + return tsdPtr->userEncoding; +} - Tcl_DStringInit(bufPtr); - if (acp == CP_UTF8) { - Tcl_DStringAppend(bufPtr, "utf-8", 5); - } else { - Tcl_DStringSetLength(bufPtr, 2 + TCL_INTEGER_SPACE); - snprintf(Tcl_DStringValue(bufPtr), 2 + TCL_INTEGER_SPACE, "cp%d", - acp); - Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr))); +void TclpReleaseEncodingForUser(void) +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + if (tsdPtr->userEncoding) { + Tcl_FreeEncoding(tsdPtr->userEncoding); + tsdPtr->userEncoding = NULL; } +} +#endif + +const char * +Tcl_GetEncodingNameForUser(Tcl_DString *bufPtr) +{ + Tcl_DStringInit(bufPtr); + Tcl_DStringAppend(bufPtr, TclpGetCodePage(), -1); return Tcl_DStringValue(bufPtr); } @@ -484,8 +594,9 @@ Tcl_GetEncodingNameFromEnvironment( Tcl_DStringInit(bufPtr); Tcl_DStringAppend(bufPtr, "utf-8", 5); return Tcl_DStringValue(bufPtr); + } else { + return Tcl_GetEncodingNameForUser(bufPtr); } - return Tcl_GetEncodingNameForUser(bufPtr); } const char * -- cgit v0.12 From 923be72f83a25825a5acca2871074d7fbe8327cb Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Sun, 1 Jun 2025 18:13:01 +0000 Subject: Cherrypick 57d619a23f - Jan's changes for unused vars --- win/tclWinInit.c | 55 +++---------------------------------------------------- 1 file changed, 3 insertions(+), 52 deletions(-) diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 23aad3e..b3ea057 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -36,12 +36,6 @@ typedef struct { WORD wReserved; } OemId; -typedef struct { - Tcl_Encoding userEncoding; -} ThreadSpecificData; - -static Tcl_ThreadDataKey dataKey; - /* * The following arrays contain the human readable strings for the * processor values. @@ -154,9 +148,9 @@ TclpGetCodePageOnce( * - added bonus, RegGetValue is much more convenient to use */ if (RegGetValueA(HKEY_LOCAL_MACHINE, - "SYSTEM\\CurrentControlSet\\Control\\Nls\\CodePage", - "ACP", RRF_RT_REG_SZ, NULL, codePage+2, - &size) != ERROR_SUCCESS) { + "SYSTEM\\CurrentControlSet\\Control\\Nls\\CodePage", + "ACP", RRF_RT_REG_SZ, NULL, codePage+2, + &size) != ERROR_SUCCESS) { /* On failure, fallback to GetACP() */ UINT acp = GetACP(); snprintf(codePage, sizeof(codePage), "cp%u", acp); @@ -530,49 +524,6 @@ TclpSetInitialEncodings(void) Tcl_DStringFree(&encodingName); } -#if 0 - -/* - *--------------------------------------------------------------------------- - * - * TclpGetEncodingForUser -- - * - * Returns the Tcl_Encoding corresponding to the user code page. - * - * Results: - * A Tcl_Encoding value or NULL if the encoding cannot be found or - * if Tcl does not support the encoding. - * - * Side effects: - * The encoding is cached in the thread local storage. - *--------------------------------------------------------------------------- - */ -Tcl_Encoding -TclpGetEncodingForUser(Tcl_Interp *interp) -{ - /* - * In keeping with Windows, the encoding will not be updated if the - * registry value changes so we never need to update it once - * successfully retrieved. - */ - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - if (tsdPtr->userEncoding == NULL) { - tsdPtr->userEncoding = - Tcl_GetEncoding(interp, TclpGetCodePage()); - } - return tsdPtr->userEncoding; -} - -void TclpReleaseEncodingForUser(void) -{ - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - if (tsdPtr->userEncoding) { - Tcl_FreeEncoding(tsdPtr->userEncoding); - tsdPtr->userEncoding = NULL; - } -} -#endif - const char * Tcl_GetEncodingNameForUser(Tcl_DString *bufPtr) { -- cgit v0.12