In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/929a7f8c537d1238e2a62caff6f9c494010473c7?hp=8d72e74e3dc5017c5a3fade48e0c74109c297ebc>
- Log -----------------------------------------------------------------
commit 929a7f8c537d1238e2a62caff6f9c494010473c7
Author: Karl Williamson <k...@cpan.org>
Date: Sun Mar 11 14:48:38 2018 -0600
locale.c: Reduce too-large indent
commit 8b24ca2dd8dfe3c0985e88b2d654c348e7644c66
Author: Karl Williamson <k...@cpan.org>
Date: Sun Mar 11 14:47:58 2018 -0600
POSIX.pod: Fix nit
commit 21972ec9e603ae4cab59cbd47983ee15c0df176a
Author: Karl Williamson <k...@cpan.org>
Date: Sun Mar 11 14:39:04 2018 -0600
perl.h: White-space, comment changes only
commit 69c5e0dbc1d307bce522321a107ca1670ec89f2c
Author: Karl Williamson <k...@cpan.org>
Date: Fri Mar 9 12:53:13 2018 -0700
Work around Microsoft threaded locale bug for localeconv()
Prior to Visual Studio 2015, the localeconv() function only looks at the
global locale, not the per-thread one it should. This works around this
by creating critical sections, switching to the global locale to call
localeconv(), then switching back. For the most common usage, it avoids
the switch by parsing a string it generates that should contain the
desired substring. This leaves the switch required for retrieving the
floating point grouping separator and the currency string, plus
POSIX::localeconv(). The first two could be avoided by extra code as
detailed in the pod for switch_to_global_locale(); patches welcome!
commit 6470dfd24226b0307246dd4530b5acd43c2ec134
Author: Karl Williamson <k...@cpan.org>
Date: Fri Mar 9 12:14:43 2018 -0700
perl.h: Move macros to earlier in the file
There should be no other differences
commit 2972341c4e56d0a957c701697676b4ccf879c92d
Author: Karl Williamson <k...@cpan.org>
Date: Thu Mar 8 21:57:52 2018 -0700
perl.h: Refactor some #defines
These put the defines dealing with locale critical sections in one
place, more logically set out.
commit 7ee02ac1cfb049c7165b5ce3955601566bb94287
Author: Karl Williamson <k...@cpan.org>
Date: Fri Mar 9 11:25:58 2018 -0700
Resync duplicated code in perl.h makedef.pl
These had gotten out of sync
commit 39e69e777b8acb3d8408d75aa0ba12fa6f7db35e
Author: Karl Williamson <k...@cpan.org>
Date: Fri Mar 9 12:06:30 2018 -0700
Don't create locale object unless threaded
PL_C_locale_obj is now only created on threaded builds on systems with
POSIX 2008. On unthreaded builds, we really should continue to use the
old tried and true library calls.
commit 1b6cb30eab88d60350ddd3276647739c0f1ce888
Author: Karl Williamson <k...@cpan.org>
Date: Thu Mar 8 14:43:23 2018 -0700
perl.h: Move some locale definitions around
For clarity, this places these locale definitions that depend solely on
having locales or not earlier, and by themselves, so don't get mixed up
with the definitions that have more complicated provenances.
In moving them, I also changed white space to accepted indentations,
and vertical alignment.
commit 18f7c09545df03958086339e81e836a888d590e4
Author: Karl Williamson <k...@cpan.org>
Date: Thu Mar 8 14:32:28 2018 -0700
perl.h: Rmv dummy definitions
These macros are core-only, so should generate a compiler error if used
outside of core, instead of compiling as no-ops.
commit 423a80b7c64953ef2d8696dae9f0bd751f996893
Author: Karl Williamson <k...@cpan.org>
Date: Fri Mar 9 11:27:28 2018 -0700
Don't create unneeded mutexes
These mutexes are needed only for unsafe threaded-locale operations.
-----------------------------------------------------------------------
Summary of changes:
ext/I18N-Langinfo/Langinfo.pm | 9 ++
ext/POSIX/POSIX.xs | 31 +++-
ext/POSIX/lib/POSIX.pod | 6 +-
locale.c | 216 ++++++++++++++++++++++---
makedef.pl | 10 +-
perl.c | 2 +-
perl.h | 367 +++++++++++++++++++++++-------------------
perlvars.h | 11 +-
8 files changed, 452 insertions(+), 200 deletions(-)
diff --git a/ext/I18N-Langinfo/Langinfo.pm b/ext/I18N-Langinfo/Langinfo.pm
index e9e84d28c2..14d3587ca5 100644
--- a/ext/I18N-Langinfo/Langinfo.pm
+++ b/ext/I18N-Langinfo/Langinfo.pm
@@ -241,6 +241,15 @@ By default only the C<langinfo()> function is exported.
Before Perl 5.28, the returned values are unreliable for the C<RADIXCHAR> and
C<THOUSEP> locale constants.
+Starting in 5.28, changing locales on threaded builds is supported on systems
+that offer thread-safe locale functions. These include POSIX 2008 systems and
+Windows starting with Visual Studio 2005, and this module will work properly
+in such situations. However, on threaded builds on Windows prior to Visual
+Studio 2015, retrieving the items C<CRNCYSTR> and C<THOUSEP> can result in a
+race with a thread that has converted to use the global locale. It is quite
+uncommon for a thread to have done this. It would be possible to construct a
+workaround for this; patches welcome: see L<perlapi/switch_to_global_locale>.
+
=head1 SEE ALSO
L<perllocale>, L<POSIX/localeconv>, L<POSIX/setlocale>, L<nl_langinfo(3)>.
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 764600c899..cf744c7ecf 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -2129,6 +2129,9 @@ localeconv()
&& defined(HAS_LOCALECONV_L) /* Prefer this thread-safe version */
bool do_free = FALSE;
locale_t cur;
+# elif defined(TS_W32_BROKEN_LOCALECONV)
+ const char * save_global;
+ const char * save_thread;
# endif
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
@@ -2161,9 +2164,23 @@ localeconv()
lcbuf = localeconv_l(cur);
# else
- LOCALE_LOCK; /* Prevent interference with other threads using
+ LOCALE_LOCK_V; /* Prevent interference with other threads using
localeconv() */
+# ifdef TS_W32_BROKEN_LOCALECONV
+ /* This is a workaround for a Windows bug prior to VS 15, in which
+ * localeconv only looks at the global locale. We toggle to the global
+ * locale; populate the return; then toggle back. We have to use
+ * LC_ALL instead of the individual ones because of another bug in
+ * Windows */
+ save_thread = savepv(Perl_setlocale(LC_NUMERIC, NULL));
+
+ _configthreadlocale(_DISABLE_PER_THREAD_LOCALE);
+
+ save_global = savepv(Perl_setlocale(LC_ALL, NULL));
+
+ Perl_setlocale(LC_ALL, save_thread);
+# endif
lcbuf = localeconv();
# endif
if (lcbuf) {
@@ -2223,7 +2240,17 @@ localeconv()
freelocale(cur);
}
# else
- LOCALE_UNLOCK;
+# ifdef TS_W32_BROKEN_LOCALECONV
+ Perl_setlocale(LC_ALL, save_global);
+
+ _configthreadlocale(_ENABLE_PER_THREAD_LOCALE);
+
+ Perl_setlocale(LC_ALL, save_thread);
+
+ Safefree(save_global);
+ Safefree(save_thread);
+# endif
+ LOCALE_UNLOCK_V;
# endif
RESTORE_LC_NUMERIC();
#endif /* HAS_LOCALECONV */
diff --git a/ext/POSIX/lib/POSIX.pod b/ext/POSIX/lib/POSIX.pod
index c12aaefa63..a319b0df3a 100644
--- a/ext/POSIX/lib/POSIX.pod
+++ b/ext/POSIX/lib/POSIX.pod
@@ -940,9 +940,13 @@ should also read L<perllocale>, which provides a
comprehensive
discussion of Perl locale handling, including
L<a section devoted to this function|perllocale/The localeconv function>.
Prior to Perl 5.28, or when operating in a non thread-safe environment,
-It should not be used in a threaded application unless it's certain that
+it should not be used in a threaded application unless it's certain that
the underlying locale is C or POSIX. This is because it otherwise
changes the locale, which globally affects all threads simultaneously.
+Windows platforms starting with Visual Studio 2005 are mostly
+thread-safe, but use of this function in those prior to Visual Studio
+2015 can interefere with a thread that has called
+L<perlapi/switch_to_global_locale>.
Here is how to query the database for the B<de> (Deutsch or German) locale.
diff --git a/locale.c b/locale.c
index 277e038327..cf371738b5 100644
--- a/locale.c
+++ b/locale.c
@@ -825,7 +825,7 @@ S_emulate_setlocale(const int category,
}
if (! default_name || strEQ(default_name, "")) {
- default_name = "C";
+ default_name = "C";
}
else if (PL_scopestack_ix != 0) {
SAVEFREEPV(default_name);
@@ -1344,14 +1344,20 @@ S_new_numeric(pTHX_ const char *newnum)
PL_numeric_underlying = TRUE;
PL_numeric_standard = isNAME_C_OR_POSIX(save_newnum);
+#ifndef TS_W32_BROKEN_LOCALECONV
+
/* If its name isn't C nor POSIX, it could still be indistinguishable from
- * them */
+ * them. But on broken Windows systems calling my_nl_langinfo() for
+ * THOUSEP can currently (but rarely) cause a race, so avoid doing that,
+ * and just always change the locale if not C nor POSIX on those systems */
if (! PL_numeric_standard) {
PL_numeric_standard = cBOOL(strEQ(".", my_nl_langinfo(RADIXCHAR,
FALSE /* Don't toggle locale */ ))
&& strEQ("", my_nl_langinfo(THOUSEP,
FALSE)));
}
+#endif
+
/* Save the new name if it isn't the same as the previous one, if any */
if (! PL_numeric_name || strNE(PL_numeric_name, save_newnum)) {
Safefree(PL_numeric_name);
@@ -2473,6 +2479,16 @@ S_my_nl_langinfo(const int item, bool toggle)
const char * temp;
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+# ifdef TS_W32_BROKEN_LOCALECONV
+
+ const char * save_global;
+ const char * save_thread;
+ int needed_size;
+ char * ptr;
+ char * e;
+ char * item_start;
+
+# endif
# endif
# ifdef HAS_STRFTIME
@@ -2572,15 +2588,35 @@ S_my_nl_langinfo(const int item, bool toggle)
/* We don't bother with localeconv_l() because any system that
* has it is likely to also have nl_langinfo() */
- LOCALE_LOCK; /* Prevent interference with other threads
- using localeconv() */
+ LOCALE_LOCK_V; /* Prevent interference with other threads
+ using localeconv() */
+
+# ifdef TS_W32_BROKEN_LOCALECONV
+
+ /* This is a workaround for a Windows bug prior to VS 15.
+ * What we do here is, while locked, switch to the global
+ * locale so localeconv() works; then switch back just before
+ * the unlock. This can screw things up if some thread is
+ * already using the global locale while assuming no other is.
+ * A different workaround would be to call GetCurrencyFormat on
+ * a known value, and parse it; patches welcome
+ *
+ * We have to use LC_ALL instead of LC_MONETARY because of
+ * another bug in Windows */
+
+ save_thread = savepv(my_setlocale(LC_ALL, NULL));
+ _configthreadlocale(_DISABLE_PER_THREAD_LOCALE);
+ save_global= savepv(my_setlocale(LC_ALL, NULL));
+ my_setlocale(LC_ALL, save_thread);
+
+# endif
lc = localeconv();
if ( ! lc
|| ! lc->currency_symbol
|| strEQ("", lc->currency_symbol))
{
- LOCALE_UNLOCK;
+ LOCALE_UNLOCK_V;
return "";
}
@@ -2600,18 +2636,115 @@ S_my_nl_langinfo(const int item, bool toggle)
PL_langinfo_buf[0] = '+';
}
- LOCALE_UNLOCK;
+# ifdef TS_W32_BROKEN_LOCALECONV
+
+ my_setlocale(LC_ALL, save_global);
+ _configthreadlocale(_ENABLE_PER_THREAD_LOCALE);
+ my_setlocale(LC_ALL, save_thread);
+ Safefree(save_global);
+ Safefree(save_thread);
+
+# endif
+
+ LOCALE_UNLOCK_V;
break;
+# ifdef TS_W32_BROKEN_LOCALECONV
+
case RADIXCHAR:
+
+ /* For this, we output a known simple floating point number to
+ * a buffer, and parse it, looking for the radix */
+
+ if (toggle) {
+ STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
+ }
+
+ if (PL_langinfo_bufsize < 10) {
+ PL_langinfo_bufsize = 10;
+ Renew(PL_langinfo_buf, PL_langinfo_bufsize, char);
+ }
+
+ needed_size = my_snprintf(PL_langinfo_buf, PL_langinfo_bufsize,
+ "%.1f", 1.5);
+ if (needed_size >= (int) PL_langinfo_bufsize) {
+ PL_langinfo_bufsize = needed_size + 1;
+ Renew(PL_langinfo_buf, PL_langinfo_bufsize, char);
+ needed_size = my_snprintf(PL_langinfo_buf,
PL_langinfo_bufsize,
+ "%.1f", 1.5);
+ assert(needed_size < (int) PL_langinfo_bufsize);
+ }
+
+ ptr = PL_langinfo_buf;
+ e = PL_langinfo_buf + PL_langinfo_bufsize;
+
+ /* Find the '1' */
+ while (ptr < e && *ptr != '1') {
+ ptr++;
+ }
+ ptr++;
+
+ /* Find the '5' */
+ item_start = ptr;
+ while (ptr < e && *ptr != '5') {
+ ptr++;
+ }
+
+ /* Everything in between is the radix string */
+ if (ptr >= e) {
+ PL_langinfo_buf[0] = '?';
+ PL_langinfo_buf[1] = '\0';
+ }
+ else {
+ *ptr = '\0';
+ Move(item_start, PL_langinfo_buf, ptr - PL_langinfo_buf,
char);
+ }
+
+ if (toggle) {
+ RESTORE_LC_NUMERIC();
+ }
+
+ retval = PL_langinfo_buf;
+ break;
+
+# else
+
+ case RADIXCHAR: /* No special handling needed */
+
+# endif
+
case THOUSEP:
if (toggle) {
STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
}
- LOCALE_LOCK; /* Prevent interference with other threads
- using localeconv() */
+ LOCALE_LOCK_V; /* Prevent interference with other threads
+ using localeconv() */
+
+# ifdef TS_W32_BROKEN_LOCALECONV
+
+ /* This should only be for the thousands separator. A
+ * different work around would be to use GetNumberFormat on a
+ * known value and parse the result to find the separator */
+ save_thread = savepv(my_setlocale(LC_ALL, NULL));
+ _configthreadlocale(_DISABLE_PER_THREAD_LOCALE);
+ save_global = savepv(my_setlocale(LC_ALL, NULL));
+ my_setlocale(LC_ALL, save_thread);
+# if 0
+ /* This is the start of code that for broken Windows replaces
+ * the above and below code, and instead calls
+ * GetNumberFormat() and then would parse that to find the
+ * thousands separator. It needs to handle UTF-16 vs -8
+ * issues. */
+
+ needed_size = GetNumberFormatEx(PL_numeric_name, 0, "1234.5",
NULL, PL_langinfo_buf, PL_langinfo_bufsize);
+ DEBUG_L(PerlIO_printf(Perl_debug_log,
+ "%s: %d: return from GetNumber, count=%d, val=%s\n",
+ __FILE__, __LINE__, needed_size, PL_langinfo_buf));
+
+# endif
+# endif
lc = localeconv();
if (! lc) {
@@ -2629,7 +2762,17 @@ S_my_nl_langinfo(const int item, bool toggle)
retval = save_to_buffer(temp, &PL_langinfo_buf,
&PL_langinfo_bufsize, 0);
- LOCALE_UNLOCK;
+# ifdef TS_W32_BROKEN_LOCALECONV
+
+ my_setlocale(LC_ALL, save_global);
+ _configthreadlocale(_ENABLE_PER_THREAD_LOCALE);
+ my_setlocale(LC_ALL, save_thread);
+ Safefree(save_global);
+ Safefree(save_thread);
+
+# endif
+
+ LOCALE_UNLOCK_V;
if (toggle) {
RESTORE_LC_NUMERIC();
@@ -3110,7 +3253,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
# endif
# endif
-# if defined(LC_ALL_MASK) && defined(HAS_POSIX_2008_LOCALE)
+# ifdef USE_POSIX_2008_LOCALE
PL_C_locale_obj = newlocale(LC_ALL_MASK, "C", (locale_t) 0);
if (! PL_C_locale_obj) {
@@ -4875,19 +5018,31 @@ Perl_my_strerror(pTHX_ const int errnum)
const bool within_locale_scope = IN_LC(LC_MESSAGES);
-# if defined(HAS_POSIX_2008_LOCALE) && defined(HAS_STRERROR_L)
+# ifndef USE_ITHREADS
- /* This function is trivial if we don't have to worry about thread safety
- * and have strerror_l(), as it handles the switch of locales so we don't
- * have to deal with that. We don't have to worry about thread safety if
- * this is an unthreaded build, or if strerror_r() is also available. Both
- * it and strerror_l() are thread-safe. Plain strerror() isn't thread
- * safe. But on threaded builds when strerror_r() is available, the
- * apparent call to strerror() below is actually a macro that
- * behind-the-scenes calls strerror_r().
- */
+ /* This function is trivial without threads. */
+ if (within_locale_scope) {
+ errstr = savepv(strerror(errnum));
+ }
+ else {
+ const char * save_locale = do_setlocale_c(LC_MESSAGES, NULL);
+
+ do_setlocale_c(LC_MESSAGES, "C");
+ errstr = savepv(strerror(errnum));
+ do_setlocale_c(LC_MESSAGES, save_locale);
+ }
+
+# elif defined(HAS_POSIX_2008_LOCALE) && defined(HAS_STRERROR_L)
+
+ /* This function is also trivial if we don't have to worry about thread
+ * safety and have strerror_l(), as it handles the switch of locales so we
+ * don't have to deal with that. We don't have to worry about thread
+ * safety if strerror_r() is also available. Both it and strerror_l() are
+ * thread-safe. Plain strerror() isn't thread safe. But on threaded
+ * builds when strerror_r() is available, the apparent call to strerror()
+ * below is actually a macro that behind-the-scenes calls strerror_r(). */
-# if ! defined(USE_ITHREADS) || defined(HAS_STRERROR_R)
+# ifdef HAS_STRERROR_R
if (within_locale_scope) {
errstr = savepv(strerror(errnum));
@@ -5011,6 +5166,25 @@ 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.
+However, on Windows systems this isn't quite true prior to Visual Studio 15,
+at which point Microsoft fixed a bug. A race can occur if you use the
+following operations on earlier Windows platforms:
+
+=over
+
+=item L<POSIX::localeconv|POSIX/localeconv>
+
+=item L<I18N::Langinfo>, items C<CRNCYSTR> and C<THOUSEP>
+
+=item L<perlapi/Perl_langinfo>, items C<CRNCYSTR> and C<THOUSEP>
+
+=back
+
+The first item is not fixable (except by upgrading to a later Visual Studio
+release), but it would be possible to work around the latter two items by using
+the Windows API functions C<GetNumberFormat> and C<GetCurrencyFormat>; patches
+welcome.
+
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
diff --git a/makedef.pl b/makedef.pl
index 06c647fc2c..a339059278 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -125,7 +125,7 @@ $define{PERL_IMPLICIT_CONTEXT} ||=
$define{USE_ITHREADS} ||
$define{MULTIPLICITY} ;
-if ($define{USE_ITHREADS} && $ARGS{PLATFORM} ne 'win32' && $^O ne 'darwin') {
+if ($define{USE_ITHREADS} && $ARGS{PLATFORM} ne 'win32' && $ARGS{PLATFORM} ne
'netware') {
$define{USE_REENTRANT_API} = 1;
}
@@ -398,6 +398,7 @@ unless ($define{'USE_ITHREADS'}) {
Perl_stashpv_hvname_match
Perl_regdupe_internal
Perl_newPADOP
+ PL_C_locale_obj
);
}
@@ -436,6 +437,13 @@ unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
);
}
+if (${^SAFE_LOCALES}) { # Don't need mutexes if have thread-safe operations
+ # except early versions of Windows need this one
+ ++$skip{PL_locale_mutex} unless $ARGS{PLATFORM} eq 'win32'
+ && ($ARGS{CCTYPE} =~ s/MSVC//r) < 140;
+ ++$skip{PL_lc_numeric_mutex};
+}
+
unless ($define{'PERL_OP_PARENT'}) {
++$skip{$_} foreach qw(
Perl_op_parent
diff --git a/perl.c b/perl.c
index 1bc15a0675..f894780a0b 100644
--- a/perl.c
+++ b/perl.c
@@ -470,7 +470,7 @@ perl_construct(pTHXx)
/* Start with 1 bucket, for DFS. It's unlikely we'll need more. */
HvMAX(PL_registered_mros) = 0;
-#ifdef HAS_POSIX_2008_LOCALE
+#ifdef USE_POSIX_2008_LOCALE
PL_C_locale_obj = newlocale(LC_ALL_MASK, "C", NULL);
#endif
diff --git a/perl.h b/perl.h
index 82c1858e2e..5462b4793e 100644
--- a/perl.h
+++ b/perl.h
@@ -52,7 +52,7 @@
/* See L<perlguts/"The Perl API"> for detailed notes on
* PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
-/* Note that from here --> to <-- the same logic is
+/* XXX NOTE that from here --> to <-- the same logic is
* repeated in makedef.pl, so be certain to update
* both places when editing. */
@@ -108,7 +108,8 @@
#endif
/* Use the reentrant APIs like localtime_r and getpwent_r */
-/* Win32 has naturally threadsafe libraries, no need to use any _r variants. */
+/* Win32 has naturally threadsafe libraries, no need to use any _r variants.
+ * XXX KEEP makedef.pl copy of this code in sync */
#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE)
&& !defined(WIN32)
# define USE_REENTRANT_API
#endif
@@ -782,6 +783,16 @@
# endif
#endif
+/* Microsoft documentation reads in the change log for VS 2015:
+ * "The localeconv function declared in locale.h now works correctly when
+ * per-thread locale is enabled. In previous versions of the library, this
+ * function would return the lconv data for the global locale, not the
+ * thread's locale."
+ */
+#if defined(WIN32) && defined(USE_THREAD_SAFE_LOCALE) && _MSC_VER < 1900
+# define TS_W32_BROKEN_LOCALECONV
+#endif
+
#include <setjmp.h>
#ifdef I_SYS_PARAM
@@ -5543,9 +5554,114 @@ typedef struct am_table_short AMTS;
#ifdef USE_LOCALE /* These locale things are all subject to change */
- /* We create a C locale object unconditionally if we have the functions to
- * do so; hence must destroy it unconditionally at the end */
-# ifndef HAS_POSIX_2008_LOCALE
+ /* Returns TRUE if the plain locale pragma without a parameter is in effect.
+ * */
+# define IN_LOCALE_RUNTIME (PL_curcop \
+ && CopHINTS_get(PL_curcop) & HINT_LOCALE)
+
+ /* Returns TRUE if either form of the locale pragma is in effect */
+# define IN_SOME_LOCALE_FORM_RUNTIME \
+ cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
+
+# define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE)
+# define IN_SOME_LOCALE_FORM_COMPILETIME \
+ cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
+
+# define IN_LOCALE \
+ (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
+# define IN_SOME_LOCALE_FORM \
+ (IN_PERL_COMPILETIME ? IN_SOME_LOCALE_FORM_COMPILETIME \
+ : IN_SOME_LOCALE_FORM_RUNTIME)
+
+# define IN_LC_ALL_COMPILETIME IN_LOCALE_COMPILETIME
+# define IN_LC_ALL_RUNTIME IN_LOCALE_RUNTIME
+
+# define IN_LC_PARTIAL_COMPILETIME cBOOL(PL_hints & HINT_LOCALE_PARTIAL)
+# define IN_LC_PARTIAL_RUNTIME \
+ (PL_curcop && CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL)
+
+# define IN_LC_COMPILETIME(category) \
+ ( IN_LC_ALL_COMPILETIME \
+ || ( IN_LC_PARTIAL_COMPILETIME \
+ && Perl__is_in_locale_category(aTHX_ TRUE, (category))))
+# define IN_LC_RUNTIME(category) \
+ (IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \
+ && Perl__is_in_locale_category(aTHX_ FALSE, (category))))
+# define IN_LC(category) \
+ (IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category))
+
+# if defined (PERL_CORE) || defined (PERL_IN_XSUB_RE)
+
+ /* This internal macro should be called from places that operate under
+ * locale rules. It there is a problem with the current locale that
+ * hasn't been raised yet, it will output a warning this time. Because
+ * this will so rarely be true, there is no point to optimize for time;
+ * instead it makes sense to minimize space used and do all the work in
+ * the rarely called function */
+# ifdef USE_LOCALE_CTYPE
+# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE \
+ STMT_START { \
+ if (UNLIKELY(PL_warn_locale)) { \
+ Perl__warn_problematic_locale(); \
+ } \
+ } STMT_END
+# else
+# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE
+# endif
+
+
+ /* These two internal macros are called when a warning should be raised,
+ * and will do so if enabled. The first takes a single code point
+ * argument; the 2nd, is a pointer to the first byte of the UTF-8 encoded
+ * string, and an end position which it won't try to read past */
+# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(cp) \
+ STMT_START { \
+ if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) { \
+ Perl_warner(aTHX_ packWARN(WARN_LOCALE), \
+ "Wide character (U+%" UVXf ") in %s",\
+ (UV) cp, OP_DESC(PL_op)); \
+ } \
+ } STMT_END
+
+# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(s, send) \
+ STMT_START { /* Check if to warn before doing the conversion work */\
+ if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) { \
+ UV cp = utf8_to_uvchr_buf((U8 *) s, (U8 *) send, NULL); \
+ Perl_warner(aTHX_ packWARN(WARN_LOCALE), \
+ "Wide character (U+%" UVXf ") in %s", \
+ (cp == 0) \
+ ? UNICODE_REPLACEMENT \
+ : (UV) cp, \
+ OP_DESC(PL_op)); \
+ } \
+ } STMT_END
+
+# endif /* PERL_CORE or PERL_IN_XSUB_RE */
+#else /* No locale usage */
+# define IN_LOCALE_RUNTIME 0
+# define IN_SOME_LOCALE_FORM_RUNTIME 0
+# define IN_LOCALE_COMPILETIME 0
+# define IN_SOME_LOCALE_FORM_COMPILETIME 0
+# define IN_LOCALE 0
+# define IN_SOME_LOCALE_FORM 0
+# define IN_LC_ALL_COMPILETIME 0
+# define IN_LC_ALL_RUNTIME 0
+# define IN_LC_PARTIAL_COMPILETIME 0
+# define IN_LC_PARTIAL_RUNTIME 0
+# define IN_LC_COMPILETIME(category) 0
+# define IN_LC_RUNTIME(category) 0
+# define IN_LC(category) 0
+#endif
+
+
+/* Locale/thread synchronization macros. These aren't needed if using
+ * thread-safe locale operations, except if something is broken */
+#if defined(USE_LOCALE) \
+ && defined(USE_ITHREADS) \
+ && (! defined(USE_THREAD_SAFE_LOCALE) || defined(TS_W32_BROKEN_LOCALECONV))
+
+/* We have a locale object holding the 'C' locale for Posix 2008 */
+#ifndef USE_POSIX_2008_LOCALE
# define _LOCALE_TERM_POSIX_2008 NOOP
# else
# define _LOCALE_TERM_POSIX_2008 \
@@ -5560,39 +5676,81 @@ typedef struct am_table_short AMTS;
} STMT_END
# endif
-# if ! defined(USE_ITHREADS) || defined(USE_THREAD_SAFE_LOCALE)
-# define LOCALE_INIT
-# define LOCALE_LOCK
-# define LOCALE_UNLOCK
+/* This is used as a generic lock for locale operations. For example this is
+ * used when calling nl_langinfo() so that another thread won't zap the
+ * contents of its buffer before it gets saved; and it's called when changing
+ * the locale of LC_MESSAGES. On some systems the latter can cause the
+ * nl_langinfo buffer to be zapped under a race condition.
+ *
+ * If combined with LC_NUMERIC_LOCK, calls to this and its corresponding unlock
+ * should be contained entirely within the locked portion of LC_NUMERIC. This
+ * mutex should be used only in very short sections of code, while
+ * LC_NUMERIC_LOCK may span more operations. By always following this
+ * convention, deadlock should be impossible. But if necessary, the two
+ * mutexes could be combined.
+ *
+ * Actually, the two macros just below with the '_V' suffixes are used in just
+ * a few places where there is a broken localeconv(), but otherwise things are
+ * thread safe, and hence don't need locking. Just below LOCALE_LOCK and
+ * LOCALE_UNLOCK are defined in terms of these for use everywhere else */
+# define LOCALE_LOCK_V \
+ STMT_START { \
+ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
+ "%s: %d: locking locale\n", __FILE__, __LINE__)); \
+ MUTEX_LOCK(&PL_locale_mutex); \
+ } STMT_END
+# define LOCALE_UNLOCK_V \
+ STMT_START { \
+ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
+ "%s: %d: unlocking locale\n", __FILE__, __LINE__)); \
+ MUTEX_UNLOCK(&PL_locale_mutex); \
+ } STMT_END
+
+/* On windows, we just need the mutex for LOCALE_LOCK */
+# ifdef TS_W32_BROKEN_LOCALECONV
+# define LOCALE_LOCK NOOP
+# define LOCALE_UNLOCK NOOP
+# define LOCALE_INIT MUTEX_INIT(&PL_locale_mutex);
+# define LOCALE_TERM MUTEX_DESTROY(&PL_locale_mutex)
# define LC_NUMERIC_LOCK(cond)
# define LC_NUMERIC_UNLOCK
-# define LOCALE_TERM STMT_START { _LOCALE_TERM_POSIX_2008; } STMT_END
# else
-# define LOCALE_INIT STMT_START { \
+# define LOCALE_LOCK LOCALE_LOCK_V
+# define LOCALE_UNLOCK LOCALE_UNLOCK_V
+
+ /* We also need to lock LC_NUMERIC for non-windows (hence Posix 2008)
+ * systems */
+# define LOCALE_INIT STMT_START { \
MUTEX_INIT(&PL_locale_mutex); \
MUTEX_INIT(&PL_lc_numeric_mutex); \
} STMT_END
-/* This mutex is used to create critical sections where we want the LC_NUMERIC
- * locale to be locked into either the C (standard) locale, or the underlying
- * locale, so that other threads interrupting this one don't change it to the
- * wrong state before we've had a chance to complete our operation. It can
- * stay locked over an entire printf operation, for example. And so is made
- * distinct from the LOCALE_LOCK mutex.
- *
- * This simulates kind of a general semaphore. The current thread will lock
- * the mutex if the per-thread variable is zero, and then increments that
- * variable. Each corresponding UNLOCK decrements the variable until it is 0,
- * at which point it actually unlocks the mutex. Since the variable is
- * per-thread, there is no race with other threads.
- *
- * The single argument is a condition to test for, and if true, to panic, as
- * this would be an attempt to complement the LC_NUMERIC state, and we're not
- * supposed to because it's locked.
- *
- * Clang improperly gives warnings for this, if not silenced:
- * https://clang.llvm.org/docs/ThreadSafetyAnalysis.html#conditional-locks
- * */
+# define LOCALE_TERM STMT_START { \
+ MUTEX_DESTROY(&PL_locale_mutex); \
+ MUTEX_DESTROY(&PL_lc_numeric_mutex); \
+ _LOCALE_TERM_POSIX_2008; \
+ } STMT_END
+
+ /* This mutex is used to create critical sections where we want the
+ * LC_NUMERIC locale to be locked into either the C (standard) locale, or
+ * the underlying locale, so that other threads interrupting this one don't
+ * change it to the wrong state before we've had a chance to complete our
+ * operation. It can stay locked over an entire printf operation, for
+ * example. And so is made distinct from the LOCALE_LOCK mutex.
+ *
+ * This simulates kind of a general semaphore. The current thread will
+ * lock the mutex if the per-thread variable is zero, and then increments
+ * that variable. Each corresponding UNLOCK decrements the variable until
+ * it is 0, at which point it actually unlocks the mutex. Since the
+ * variable is per-thread, there is no race with other threads.
+ *
+ * The single argument is a condition to test for, and if true, to panic,
+ * as this would be an attempt to complement the LC_NUMERIC state, and
+ * we're not supposed to because it's locked.
+ *
+ * Clang improperly gives warnings for this, if not silenced:
+ * https://clang.llvm.org/docs/ThreadSafetyAnalysis.html#conditional-locks
+ * */
# define LC_NUMERIC_LOCK(cond_to_panic_if_already_locked) \
CLANG_DIAG_IGNORE(-Wthread-safety) \
STMT_START { \
@@ -5634,143 +5792,16 @@ typedef struct am_table_short AMTS;
} STMT_END \
CLANG_DIAG_RESTORE
-/* This is used as a generic lock for locale operations. For example this is
- * used when calling nl_langinfo() so that another thread won't zap the
- * contents of its buffer before it gets saved; and it's called when changing
- * the locale of LC_MESSAGES. On some systems the latter can cause the
- * nl_langinfo buffer to be zapped under a race condition.
- *
- * If combined with LC_NUMERIC_LOCK, calls to this and its corresponding unlock
- * should be contained entirely within the locked portion of LC_NUMERIC. This
- * mutex should be used only in very short sections of code, while
- * LC_NUMERIC_LOCK may span more operations. By always following this
- * convention, deadlock should be impossible. But if necessary, the two
- * mutexes could be combined */
-# define LOCALE_LOCK \
- STMT_START { \
- DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
- "%s: %d: locking locale\n", __FILE__, __LINE__)); \
- MUTEX_LOCK(&PL_locale_mutex); \
- } STMT_END
-# define LOCALE_UNLOCK \
- STMT_START { \
- DEBUG_Lv(PerlIO_printf(Perl_debug_log, \
- "%s: %d: unlocking locale\n", __FILE__, __LINE__)); \
- MUTEX_UNLOCK(&PL_locale_mutex); \
- } STMT_END
-
-# define LOCALE_TERM \
- STMT_START { \
- MUTEX_DESTROY(&PL_locale_mutex); \
- MUTEX_DESTROY(&PL_lc_numeric_mutex); \
- _LOCALE_TERM_POSIX_2008; \
- } STMT_END
-# endif
-
-/* Returns TRUE if the plain locale pragma without a parameter is in effect
- */
-# define IN_LOCALE_RUNTIME (PL_curcop \
- && CopHINTS_get(PL_curcop) & HINT_LOCALE)
-
-/* Returns TRUE if either form of the locale pragma is in effect */
-# define IN_SOME_LOCALE_FORM_RUNTIME \
- cBOOL(CopHINTS_get(PL_curcop) & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
-
-# define IN_LOCALE_COMPILETIME cBOOL(PL_hints & HINT_LOCALE)
-# define IN_SOME_LOCALE_FORM_COMPILETIME \
- cBOOL(PL_hints & (HINT_LOCALE|HINT_LOCALE_PARTIAL))
-
-# define IN_LOCALE \
- (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
-# define IN_SOME_LOCALE_FORM \
- (IN_PERL_COMPILETIME ? IN_SOME_LOCALE_FORM_COMPILETIME \
- : IN_SOME_LOCALE_FORM_RUNTIME)
-
-# define IN_LC_ALL_COMPILETIME IN_LOCALE_COMPILETIME
-# define IN_LC_ALL_RUNTIME IN_LOCALE_RUNTIME
-
-# define IN_LC_PARTIAL_COMPILETIME cBOOL(PL_hints & HINT_LOCALE_PARTIAL)
-# define IN_LC_PARTIAL_RUNTIME \
- (PL_curcop && CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL)
-
-# define IN_LC_COMPILETIME(category) \
- (IN_LC_ALL_COMPILETIME || (IN_LC_PARTIAL_COMPILETIME \
- && Perl__is_in_locale_category(aTHX_ TRUE, (category))))
-# define IN_LC_RUNTIME(category) \
- (IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \
- && Perl__is_in_locale_category(aTHX_ FALSE, (category))))
-# define IN_LC(category) \
- (IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category))
-
-# if defined (PERL_CORE) || defined (PERL_IN_XSUB_RE)
-
- /* This internal macro should be called from places that operate under
- * locale rules. It there is a problem with the current locale that
- * hasn't been raised yet, it will output a warning this time. Because
- * this will so rarely be true, there is no point to optimize for
- * time; instead it makes sense to minimize space used and do all the
- * work in the rarely called function */
-# ifdef USE_LOCALE_CTYPE
-# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE \
- STMT_START { \
- if (UNLIKELY(PL_warn_locale)) { \
- Perl__warn_problematic_locale(); \
- } \
- } STMT_END
-# else
-# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE
-# endif
-
-
- /* These two internal macros are called when a warning should be raised,
- * and will do so if enabled. The first takes a single code point
- * argument; the 2nd, is a pointer to the first byte of the UTF-8 encoded
- * string, and an end position which it won't try to read past */
-# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(cp) \
- STMT_START { \
- if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) { \
- Perl_warner(aTHX_ packWARN(WARN_LOCALE), \
- "Wide character (U+%" UVXf ") in %s",\
- (UV) cp, OP_DESC(PL_op)); \
- } \
- } STMT_END
-
-# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(s, send) \
- STMT_START { /* Check if to warn before doing the conversion work */\
- if (! PL_in_utf8_CTYPE_locale && ckWARN(WARN_LOCALE)) { \
- UV cp = utf8_to_uvchr_buf((U8 *) s, (U8 *) send, NULL); \
- Perl_warner(aTHX_ packWARN(WARN_LOCALE), \
- "Wide character (U+%" UVXf ") in %s", \
- (cp == 0) \
- ? UNICODE_REPLACEMENT \
- : (UV) cp, \
- OP_DESC(PL_op)); \
- } \
- } STMT_END
-
-# endif /* PERL_CORE or PERL_IN_XSUB_RE */
-#else /* No locale usage */
-# define LOCALE_INIT
-# define LOCALE_TERM
-# define LOCALE_LOCK
-# define LOCALE_UNLOCK
-# define IN_LOCALE_RUNTIME 0
-# define IN_SOME_LOCALE_FORM_RUNTIME 0
-# define IN_LOCALE_COMPILETIME 0
-# define IN_SOME_LOCALE_FORM_COMPILETIME 0
-# define IN_LOCALE 0
-# define IN_SOME_LOCALE_FORM 0
-# define IN_LC_ALL_COMPILETIME 0
-# define IN_LC_ALL_RUNTIME 0
-# define IN_LC_PARTIAL_COMPILETIME 0
-# define IN_LC_PARTIAL_RUNTIME 0
-# define IN_LC_COMPILETIME(category) 0
-# define IN_LC_RUNTIME(category) 0
-# define IN_LC(category) 0
-
-# define _CHECK_AND_WARN_PROBLEMATIC_LOCALE
-# define _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(a)
-# define _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(a,b)
+# endif /* End of needs locking LC_NUMERIC */
+#else /* Below is no locale sync needed */
+# define LOCALE_INIT
+# define LOCALE_LOCK
+# define LOCALE_LOCK_V
+# define LOCALE_UNLOCK
+# define LOCALE_UNLOCK_V
+# define LC_NUMERIC_LOCK(cond)
+# define LC_NUMERIC_UNLOCK
+# define LOCALE_TERM
#endif
#ifdef USE_LOCALE_NUMERIC
diff --git a/perlvars.h b/perlvars.h
index be67a59988..ac97ebcd99 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -99,16 +99,15 @@ PERLVARI(G, mmap_page_size, IV, 0)
#if defined(USE_ITHREADS)
PERLVAR(G, hints_mutex, perl_mutex) /* Mutex for refcounted he refcounting
*/
+# if ! defined(USE_THREAD_SAFE_LOCALE) || defined(TS_W32_BROKEN_LOCALECONV)
PERLVAR(G, locale_mutex, perl_mutex) /* Mutex for setlocale() changing */
+# endif
+# ifndef USE_THREAD_SAFE_LOCALE
PERLVAR(G, lc_numeric_mutex, perl_mutex) /* Mutex for switching LC_NUMERIC */
-
+# endif
#endif
-/* Proxy for HAS_POSIX_2008_LOCALE, since that is not defined in time for this
*/
-#if defined(HAS_NEWLOCALE) \
- && defined(HAS_FREELOCALE) \
- && defined(HAS_USELOCALE) \
- && ! defined(NO_POSIX_2008_LOCALE)
+#ifdef USE_POSIX_2008_LOCALE
PERLVAR(G, C_locale_obj, locale_t)
#endif
--
Perl5 Master Repository
