This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Work around Microsoft threaded locale bug for localeconv()
authorKarl Williamson <khw@cpan.org>
Fri, 9 Mar 2018 19:53:13 +0000 (12:53 -0700)
committerKarl Williamson <khw@cpan.org>
Mon, 12 Mar 2018 16:22:01 +0000 (10:22 -0600)
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!

ext/I18N-Langinfo/Langinfo.pm
ext/POSIX/POSIX.xs
ext/POSIX/lib/POSIX.pod
locale.c
makedef.pl
perl.h
perlvars.h

index e9e84d2..14d3587 100644 (file)
@@ -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)>.
index 764600c..cf744c7 100644 (file)
@@ -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 */
index c12aaef..a4989f7 100644 (file)
@@ -943,6 +943,10 @@ 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
 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.
 
index e58fb3b..85ca1b8 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -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();
@@ -5023,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
index 417fcd7..a339059 100644 (file)
@@ -437,8 +437,10 @@ unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
                         );
 }
 
-if (${^SAFE_LOCALES}) {
-    ++$skip{PL_locale_mutex};
+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};
 }
 
diff --git a/perl.h b/perl.h
index 169bcef..44246d3 100644 (file)
--- a/perl.h
+++ b/perl.h
 #  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
@@ -5643,11 +5653,12 @@ typedef struct am_table_short AMTS;
 #  define IN_LC(category)                  0
 #endif
 
+
 /* Locale/thread synchronization macros.  These aren't needed if using
- * thread-safe locale operations */
+ * thread-safe locale operations, except if something is broken */
 #if    defined(USE_LOCALE)                                                  \
  &&    defined(USE_ITHREADS)                                                \
- && ! defined(USE_THREAD_SAFE_LOCALE)
+ && (! 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
@@ -5676,21 +5687,40 @@ typedef struct am_table_short AMTS;
  * 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                                                       \
+ * 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                                                     \
+#  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
 
-#  define LOCALE_INIT         STMT_START {                                  \
+/* 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
+#  else
+#    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
@@ -5762,10 +5792,13 @@ typedef struct am_table_short AMTS;
         } STMT_END                                                          \
         CLANG_DIAG_RESTORE
 
+#  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
index d327583..ac97ebc 100644 (file)
@@ -99,8 +99,10 @@ PERLVARI(G, mmap_page_size, IV, 0)
 
 #if defined(USE_ITHREADS)
 PERLVAR(G, hints_mutex, perl_mutex)    /* Mutex for refcounted he refcounting */
-#ifndef USE_THREAD_SAFE_LOCALE
+#  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