develooper Front page | perl.perl5.changes | Postings from March 2018

[perl.git] branch smoke-me/khw-locale updated.v5.27.8-425-gdce0024a4b

From:
Karl Williamson
Date:
March 2, 2018 04:02
Subject:
[perl.git] branch smoke-me/khw-locale updated.v5.27.8-425-gdce0024a4b
Message ID:
E1erbu7-00084l-Bf@git.dc.perl.space
In perl.git, the branch smoke-me/khw-locale has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/dce0024a4b0e8f0b4ee3da972977a2b5e91d5005?hp=86df671e3d19d9883363c31977df1e93a88f0a4f>

- Log -----------------------------------------------------------------
commit dce0024a4b0e8f0b4ee3da972977a2b5e91d5005
Author: Karl Williamson <khw@cpan.org>
Date:   Thu Mar 1 21:01:44 2018 -0700

    workaround localeconv bug

-----------------------------------------------------------------------

Summary of changes:
 ext/POSIX/POSIX.xs      |  29 +++++++
 ext/POSIX/lib/POSIX.pm  |   2 +-
 ext/POSIX/lib/POSIX.pod |   1 +
 locale.c                | 226 +++++++++++++++++++++++++++++++++++++++++++++++-
 perl.h                  |  11 +++
 5 files changed, 265 insertions(+), 4 deletions(-)

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index c6c9299451..a839ca0ce7 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -2168,7 +2168,22 @@ localeconv()
 #  else
         LOCALE_LOCK;    /* 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. */
 
+        save_monetary_thread = savepv(Perl_setlocale(LC_MONETARY, NULL));
+        save_numeric_thread  = savepv(Perl_setlocale(LC_NUMERIC, NULL));
+
+        _configthreadlocale(_DISABLE_PER_THREAD_LOCALE);
+
+        save_monetary_global = savepv(Perl_setlocale(LC_MONETARY, NULL));
+        save_numeric_global  = savepv(Perl_setlocale(LC_NUMERIC, NULL));
+
+        Perl_setlocale(LC_MONETARY, save_monetary_thread);
+        Perl_setlocale(LC_NUMERIC,  save_numeric_thread);
+#    endif
         lcbuf = localeconv();
 #  endif
 	if (lcbuf) {
@@ -2228,6 +2243,20 @@ localeconv()
             freelocale(cur);
         }
 #  else
+#    ifdef TS_W32_BROKEN_LOCALECONV
+        Perl_setlocale(LC_MONETARY, save_monetary_global);
+        Perl_setlocale(LC_NUMERIC, save_numeric_global);
+
+        _configthreadlocale(_ENABLE_PER_THREAD_LOCALE);
+
+        Perl_setlocale(LC_MONETARY, save_monetary_thread);
+        Perl_setlocale(LC_NUMERIC, save_numeric_thread);
+
+        Safefree(save_monetary_global);
+        Safefree(save_monetary_thread);
+        Safefree(save_numeric_global);
+        Safefree(save_numeric_thread);
+#    endif
         LOCALE_UNLOCK;
 #  endif
         RESTORE_LC_NUMERIC();
diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm
index 8f61f6ede9..a05ec02be2 100644
--- a/ext/POSIX/lib/POSIX.pm
+++ b/ext/POSIX/lib/POSIX.pm
@@ -4,7 +4,7 @@ use warnings;
 
 our ($AUTOLOAD, %SIGRT);
 
-our $VERSION = '1.82';
+our $VERSION = '1.83';
 
 require XSLoader;
 
diff --git a/ext/POSIX/lib/POSIX.pod b/ext/POSIX/lib/POSIX.pod
index c12aaefa63..3bb3d9f5ee 100644
--- a/ext/POSIX/lib/POSIX.pod
+++ b/ext/POSIX/lib/POSIX.pod
@@ -940,6 +940,7 @@ 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,
+XXX
 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.
diff --git a/locale.c b/locale.c
index ead73e5554..50e7d0b29d 100644
--- a/locale.c
+++ b/locale.c
@@ -1334,8 +1334,13 @@ 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 we can't rely on this on systems that use a broken
+     * localeconv() implementing nl_langinfo (though actually the code above is
+     * reliable, it just has to switch into the global locale, which would
+     * cause issues for any thread running the global locale) */
     if (! PL_numeric_standard) {
         PL_numeric_standard = cBOOL(strEQ(".", my_nl_langinfo(PERL_RADIXCHAR,
                                             FALSE /* Don't toggle locale */  ))
@@ -1343,6 +1348,8 @@ S_new_numeric(pTHX_ const char *newnum)
                                                               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);
@@ -2522,6 +2529,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
 
@@ -2542,8 +2559,7 @@ S_my_nl_langinfo(const int item, bool toggle)
         switch (item) {
             Size_t len;
 
-            /* These 2 are unimplemented */
-            case PERL_CODESET:
+            /* This is unimplemented */
             case PERL_ERA:      /* For use with strftime() %E modifier */
 
             default:
@@ -2555,6 +2571,51 @@ S_my_nl_langinfo(const int item, bool toggle)
             case PERL_NOEXPR:    return "^[-0nN]";
             case PERL_NOSTR:     return "no";
 
+            case PERL_CODESET:
+
+#  ifndef WIN32
+
+                return "";
+
+#  else
+
+                {
+                    const char * p;
+                    const char * name = my_setlocale(LC_CTYPE, NULL);
+                    const char * first = (const char *) strchr(name, '.');
+
+                    if (! first) {
+                        goto has_nondigit;
+                    }
+
+                    first++;
+                    p = first;
+
+                    while (*p) {
+                        if (! isDIGIT(*p)) {
+                            goto has_nondigit;
+                        }
+
+                        p++;
+                    }
+
+                    save_to_buffer("CP", &PL_langinfo_buf,
+                                         &PL_langinfo_bufsize, 0);
+                    retval = save_to_buffer(first, &PL_langinfo_buf,
+                                            &PL_langinfo_bufsize, 2);
+
+                    return retval;
+
+                  has_nondigit:
+
+                    if (isNAME_C_OR_POSIX(name)) {
+                        return "ANSI_X3.4-1968";
+                    }
+
+                    return "";
+                }
+
+#  endif
 #  ifdef HAS_LOCALECONV
 
             case PERL_CRNCYSTR:
@@ -2565,6 +2626,21 @@ S_my_nl_langinfo(const int item, bool toggle)
                 LOCALE_LOCK;    /* 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.  It can't be helped though, as XXX */
+
+                save_thread = savepv(my_setlocale(LC_MONETARY, NULL));
+                _configthreadlocale(_DISABLE_PER_THREAD_LOCALE);
+                save_global= savepv(my_setlocale(LC_MONETARY, NULL));
+                my_setlocale(LC_MONETARY, save_thread);
+
+#    endif
+
                 lc = localeconv();
                 if (   ! lc
                     || ! lc->currency_symbol
@@ -2590,10 +2666,75 @@ S_my_nl_langinfo(const int item, bool toggle)
                     PL_langinfo_buf[0] = '+';
                 }
 
+#    ifdef TS_W32_BROKEN_LOCALECONV
+
+                my_setlocale(LC_MONETARY, save_global);
+                _configthreadlocale(_ENABLE_PER_THREAD_LOCALE);
+                my_setlocale(LC_MONETARY, save_thread);
+                Safefree(save_global);
+                Safefree(save_thread);
+
+#    endif
+
                 LOCALE_UNLOCK;
                 break;
 
+#    ifdef TS_W32_BROKEN_LOCALECONV
+
+            case PERL_RADIXCHAR:
+
+                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;
+                while (ptr < e && *ptr != '1') {
+                    ptr++;
+                }
+                ptr++;
+                item_start = ptr;
+                while (ptr < e && *ptr != '5') {
+                    ptr++;
+                }
+
+                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 PERL_RADIXCHAR:
+
+#    endif
+
             case PERL_THOUSEP:
 
                 if (toggle) {
@@ -2603,6 +2744,15 @@ S_my_nl_langinfo(const int item, bool toggle)
                 LOCALE_LOCK;    /* Prevent interference with other threads
                                    using localeconv() */
 
+#    ifdef TS_W32_BROKEN_LOCALECONV
+
+                save_thread = savepv(my_setlocale(LC_NUMERIC, NULL));
+                _configthreadlocale(_DISABLE_PER_THREAD_LOCALE);
+                save_global = savepv(my_setlocale(LC_NUMERIC, NULL));
+                my_setlocale(LC_NUMERIC, save_thread);
+
+#    endif
+
                 lc = localeconv();
                 if (! lc) {
                     temp = "";
@@ -2619,6 +2769,16 @@ S_my_nl_langinfo(const int item, bool toggle)
                 retval = save_to_buffer(temp, &PL_langinfo_buf,
                                         &PL_langinfo_bufsize, 0);
 
+#    ifdef TS_W32_BROKEN_LOCALECONV
+
+                my_setlocale(LC_NUMERIC, save_global);
+                _configthreadlocale(_ENABLE_PER_THREAD_LOCALE);
+                my_setlocale(LC_NUMERIC, save_thread);
+                Safefree(save_global);
+                Safefree(save_thread);
+
+#    endif
+
                 LOCALE_UNLOCK;
 
                 if (toggle) {
@@ -2627,6 +2787,52 @@ S_my_nl_langinfo(const int item, bool toggle)
 
                 break;
 
+#    if 0
+                if (PL_langinfo_bufsize < 10) {
+                    PL_langinfo_bufsize = 10;
+                    Renew(PL_langinfo_buf, PL_langinfo_bufsize, char);
+                }
+
+                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));
+
+                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;
+                while (ptr < e && *ptr != '1') {
+                    ptr++;
+                }
+                ptr++;
+                item_start = ptr;
+                while (ptr < e && *ptr != '5') {
+                    ptr++;
+                }
+
+                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;
+#    endif
 #  endif
 #  ifdef HAS_STRFTIME
 
@@ -5005,6 +5211,20 @@ 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<PERL_CRNCYSTR> and C<PERL_THOUSEP>
+
+=item L<perlapi/Perl_langinfo>, items C<PERL_CRNCYSTR> and C<PERL_THOUSEP>
+
+=back
+
 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/perl.h b/perl.h
index deafa0f5f3..ba598aa232 100644
--- a/perl.h
+++ b/perl.h
@@ -5560,6 +5560,17 @@ typedef struct am_table_short AMTS;
                     } STMT_END
 #  endif
 
+/*  Microsoft documentation reads:
+ *     "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."
+ *  "now" refers to VS 2015.
+ */
+#if defined(WIN32) && defined(USE_THREAD_SAFE_LOCALE) && _MSC_VER < 1900
+#    define TS_W32_BROKEN_LOCALECONV
+#endif
+
 #  if ! defined(USE_ITHREADS) || defined(USE_THREAD_SAFE_LOCALE)
 #    define LOCALE_INIT
 #    define LOCALE_LOCK

-- 
Perl5 Master Repository



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About