diff options
-rw-r--r-- | dist/ExtUtils-ParseXS/lib/perlxs.pod | 2 | ||||
-rw-r--r-- | embed.fnc | 1 | ||||
-rw-r--r-- | embed.h | 1 | ||||
-rw-r--r-- | locale.c | 71 | ||||
-rw-r--r-- | pod/perlvar.pod | 2 | ||||
-rw-r--r-- | proto.h | 1 |
6 files changed, 76 insertions, 2 deletions
diff --git a/dist/ExtUtils-ParseXS/lib/perlxs.pod b/dist/ExtUtils-ParseXS/lib/perlxs.pod index 28f88bc78c..1419ee0ddf 100644 --- a/dist/ExtUtils-ParseXS/lib/perlxs.pod +++ b/dist/ExtUtils-ParseXS/lib/perlxs.pod @@ -2316,7 +2316,7 @@ operates only on the global locale, whereas each thread has its own locale, paying no attention to the global one. Since converting these non-Perl libraries to C<Perl_setlocale> is out of the question, there is a new function in v5.28 -C<switch_to_global_locale> that will +L<C<switch_to_global_locale>|perlapi/switch_to_global_locale> that will switch the thread it is called from so that any system C<setlocale> calls will have their desired effect. The function L<C<sync_locale>|perlapi/sync_locale> must be called before returning to @@ -1309,6 +1309,7 @@ Xpn |void |_warn_problematic_locale Xp |void |set_numeric_underlying Xp |void |set_numeric_standard Xp |bool |_is_in_locale_category|const bool compiling|const int category +Apdn |void |switch_to_global_locale Apdn |bool |sync_locale ApMn |void |thread_locale_init ApMn |void |thread_locale_term @@ -714,6 +714,7 @@ #define sv_vsetpvf(a,b,c) Perl_sv_vsetpvf(aTHX_ a,b,c) #define sv_vsetpvf_mg(a,b,c) Perl_sv_vsetpvf_mg(aTHX_ a,b,c) #define sv_vsetpvfn(a,b,c,d,e,f,g) Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g) +#define switch_to_global_locale Perl_switch_to_global_locale #define sync_locale Perl_sync_locale #define taint_env() Perl_taint_env(aTHX) #define taint_proper(a,b) Perl_taint_proper(aTHX_ a,b) @@ -4945,6 +4945,77 @@ Perl_my_strerror(pTHX_ const int errnum) /* +=for apidoc switch_to_global_locale + +On systems without locale support, or on single-threaded builds, or on +platforms that do not support per-thread locale operations, this function does +nothing. On such systems that do have locale support, only a locale global to +the whole program is available. + +On multi-threaded builds on systems that do have per-thread locale operations, +this function converts the thread it is running in to use the global locale. +This is for code that has not yet or cannot be updated to handle multi-threaded +locale operation. As long as only a single thread is so-converted, everything +works fine, as all the other threads continue to ignore the global one, so only +this thread looks at it. + +Without this function call, threads that use the L<C<setlocale(3)>> system +function will not work properly, as all the locale-sensitive functions will +look at the per-thread locale, and C<setlocale> will have no effect on this +thread. + +Perl code should convert to either call +L<C<Perl_setlocale>|perlapi/Perl_setlocale> (which is a drop-in for the system +C<setlocale>) or use the methods given in L<perlcall> to call +L<C<POSIX::setlocale>|POSIX/setlocale>. Either one will transparently properly +handle all cases of single- vs multi-thread, POSIX 2008-supported or not. + +Non-Perl libraries, such as C<gtk>, that call the system C<setlocale> can +continue to work if this function is called before transferring control to the +library. + +Upon return from the code that needs to use the global locale, +L<C<sync_locale()>|perlapi/sync_locale> should be called to restore the safe +multi-thread operation. + +=cut +*/ + +void +Perl_switch_to_global_locale() +{ + +#ifdef USE_THREAD_SAFE_LOCALE +# ifdef WIN32 + + _configthreadlocale(_DISABLE_PER_THREAD_LOCALE); + +# else +# ifdef HAS_QUERYLOCALE + + setlocale(LC_ALL, querylocale(LC_ALL_MASK, uselocale((locale_t) 0))); + +# else + + { + unsigned int i; + + for (i = 0; i < LC_ALL_INDEX; i++) { + setlocale(categories[i], do_setlocale_r(categories[i], NULL)); + } + } + +# endif + + uselocale(LC_GLOBAL_LOCALE); + +# endif +#endif + +} + +/* + =for apidoc sync_locale L<C<Perl_setlocale>|perlapi/Perl_setlocale> can be used at any time to query or diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 06d1ef9a93..ba23771c8d 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -2267,7 +2267,7 @@ value is 1) or not (the value is 0). This variable is always 1 if the perl has been compiled without threads. It is also 1 if this perl is using thread-safe locale operations. Note that an individual thread may choose to use the global locale (generally unsafe) by calling -C<switch_to_global_locale>. This variable currently is still +L<perlapi/switch_to_global_locale>. This variable currently is still set to 1 in such threads. This variable is read-only. @@ -3513,6 +3513,7 @@ PERL_CALLCONV SV* Perl_swash_init(pTHX_ const char* pkg, const char* name, SV* l #define PERL_ARGS_ASSERT_SWASH_INIT \ assert(pkg); assert(name); assert(listsv) +PERL_CALLCONV void Perl_switch_to_global_locale(void); PERL_CALLCONV bool Perl_sync_locale(void); PERL_CALLCONV void Perl_sys_init(int* argc, char*** argv); #define PERL_ARGS_ASSERT_SYS_INIT \ |