Add thread-safe locale handling

This (large) commit allows locales to be used in threaded perls on
platforms that support it.  This includes recent Windows and Posix 2008
ones.

21 files changed, 1377 insertions, 108 deletions

diff --git a/dist/ExtUtils-ParseXS/lib/perlxs.pod b/dist/ExtUtils-ParseXS/lib/perlxs.pod
index 2011ac890a..28f88bc78c 100644
--- a/dist/ExtUtils-ParseXS/lib/perlxs.pod
+++ b/dist/ExtUtils-ParseXS/lib/perlxs.pod
@@ -2195,7 +2195,7 @@ To summarize, here's what to expect and how to handle locales in XS code:
 =item Non-locale-aware XS code
 
 Keep in mind that even if you think your code is not locale-aware, it
-may call a C library function that is.  Hopefully the man page for such
+may call a library function that is.  Hopefully the man page for such
 a function will indicate that dependency, but the documentation is
 imperfect.
 
@@ -2231,9 +2231,107 @@ L<perlapi/STORE_LC_NUMERIC_FORCE_TO_UNDERLYING>, and
 L<perlapi/RESTORE_LC_NUMERIC> should be used to affect any needed
 change.
 
-However, some alien libraries that may be called do set it, such as
-C<Gtk>.  This can cause problems for the perl core and other modules.
-Starting in v5.20.1, calling the function
+But, starting with Perl v5.28, locales are thread-safe on platforms that
+support this functionality.  Windows has this starting with Visual
+Studio 2005.  Many other modern platforms support the thread-safe POSIX
+2008 functions.  The C C<#define> C<USE_THREAD_SAFE_LOCALE> will be
+defined iff this build is using these.  From Perl-space, the read-only
+variable C<${SAFE_LOCALES}> is 1 if either the build is not threaded, or
+if C<USE_THREAD_SAFE_LOCALE> is defined; otherwise it is 0.
+
+The way this works under-the-hood is that every thread has a choice of
+using a locale specific to it (this is the Windows and POSIX 2008
+functionality), or the global locale that is accessible to all threads
+(this is the functionality that has always been there).  The
+implementations for Windows and POSIX are completely different.  On
+Windows, the runtime can be set up so that the standard
+L<C<setlocale(3)>> function either only knows about the global locale or
+the locale for this thread.  On POSIX, C<setlocale> always deals with
+the global locale, and other functions have been created to handle
+per-thread locales.  Perl makes this transparent to perl-space code.  It
+continues to use C<POSIX::setlocale()>, and the interpreter translates
+that into the per-thread functions.
+
+All other locale-senstive functions automatically use the per-thread
+locale, if that is turned on, and failing that, the global locale.  Thus
+calls to C<setlocale> are ineffective on POSIX systems for the current
+thread if that thread is using a per-thread locale.  If perl is compiled
+for single-thread operation, it does not use the per-thread functions,
+so C<setlocale> does work as expected.
+
+If you have loaded the L<C<POSIX>> module you can use the methods given
+in L<perlcall> to call L<C<POSIX::setlocale>|POSIX/setlocale> to safely
+change or query the locale (on systems where it is safe to do so), or
+you can use the new 5.28 function L<perlapi/Perl_setlocale> instead,
+which is a drop-in replacement for the system L<C<setlocale(3)>>, and
+handles single-threaded and multi-threaded applications transparently.
+
+There are some locale-related library calls that still aren't
+thread-safe because they return data in a buffer global to all threads.
+In the past, these didn't matter as locales weren't thread-safe at all.
+But now you have to be aware of them in case your module is called in a
+multi-threaded application.  The known ones are
+
+ asctime()
+ ctime()
+ gcvt() [POSIX.1-2001 only (function removed in POSIX.1-2008)]
+ getdate()
+ wcrtomb() if its final argument is NULL
+ wcsrtombs() if its final argument is NULL
+ wcstombs()
+ wctomb()
+
+Some of these shouldn't really be called in a Perl application, and for
+others there are thread-safe versions of these already implemented:
+
+ asctime_r()
+ ctime_r()
+ Perl_langinfo()
+
+The C<_r> forms are automatically used, starting in Perl 5.28, if you
+compile your code, with
+
+ #define PERL_REENTRANT
+
+See also L<perlapi/Perl_langinfo>.
+You can use the methods given in L<perlcall>, to get the best available
+locale-safe versions of these
+
+ POSIX::localeconv()
+ POSIX::wcstombs()
+ POSIX::wctomb()
+
+And note, that some items returned by C<Localeconv> are available
+through L<perlapi/Perl_langinfo>.
+
+The others shouldn't be used in a threaded application.
+
+Some modules may call a non-perl library that is locale-aware.  This is
+fine as long as it doesn't try to query or change the locale using the
+system C<setlocale>.  But if these do call the system C<setlocale>,
+those calls may be ineffective.  Instead,
+L<C<Perl_setlocale>|perlapi/Perl_setlocale> works in all circumstances.
+Plain setlocale is ineffective on multi-threaded POSIX 2008 systems.  It
+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
+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
+perl.
+
+This thread can change the locale all it wants and it won't affect any
+other thread, except any that also have been switched to the global
+locale.  This means that a multi-threaded application can have a single
+thread using an alien library without a problem; but no more than a
+single thread can be so-occupied.  Bad results likely will happen.
+
+In perls without multi-thread locale support, some alien libraries,
+such as C<Gtk> change locales.  This can cause problems for the Perl
+core and other modules.  For these, before control is returned to
+perl, starting in v5.20.1, calling the function
 L<sync_locale()|perlapi/sync_locale> from XS should be sufficient to
 avoid most of these problems.  Prior to this, you need a pure Perl
 statement that does this:
diff --git a/dist/threads/lib/threads.pm b/dist/threads/lib/threads.pm
index 2eb926a071..1b99567ef2 100644
--- a/dist/threads/lib/threads.pm
+++ b/dist/threads/lib/threads.pm
@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '2.21';      # remember to update version in POD!
+our $VERSION = '2.22';      # remember to update version in POD!
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -937,6 +937,33 @@ C<chdir()>) will affect all the threads in the application.
 On MSWin32, each thread maintains its own the current working directory
 setting.
 
+=item Locales
+
+Prior to Perl 5.28, locales could not be used with threads, due to various
+race conditions.  Starting in that release, on systems that implement
+thread-safe locale functions, threads can be used, with some caveats.
+This includes Windows starting with Visual Studio 2005, and systems compatible
+with POSIX 2008.  See L<perllocale/Multi-threaded operation>.
+
+Each thread (except the main thread) is started using the C locale.  The main
+thread is started like all other Perl programs; see L<perllocale/ENVIRONMENT>.
+You can switch locales in any thread as often as you like.
+
+If you want to inherit the parent thread's locale, you can, in the parent, set
+a variable like so:
+
+    $foo = POSIX::setlocale(LC_ALL, NULL);
+
+and then pass to threads->create() a sub that closes over C<$foo>.  Then, in
+the child, you say
+
+    POSIX::setlocale(LC_ALL, $foo);
+
+Or you can use the facilities in L<threads::shared> to pass C<$foo>;
+or if the environment hasn't changed, in the child, do
+
+    POSIX::setlocale(LC_ALL, "");
+
 =item Environment variables
 
 Currently, on all platforms except MSWin32, all I<system> calls (e.g., using
diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs
index 4e9e31fdeb..3da9165c27 100644
--- a/dist/threads/threads.xs
+++ b/dist/threads/threads.xs
@@ -580,6 +580,8 @@ S_ithread_run(void * arg)
     S_set_sigmask(&thread->initial_sigmask);
 #endif
 
+    thread_locale_init();
+
     PL_perl_destruct_level = 2;
 
     {
@@ -665,6 +667,8 @@ S_ithread_run(void * arg)
     MUTEX_UNLOCK(&thread->mutex);
     MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
 
+    thread_locale_term();
+
     /* Exit application if required */
     if (exit_app) {
         (void)S_jmpenv_run(aTHX_ 2, thread, NULL, &exit_app, &exit_code);
diff --git a/embed.fnc b/embed.fnc
index e7a32b7dc8..73139f33a6 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1310,6 +1310,8 @@ Xp	|void	|set_numeric_underlying
 Xp	|void	|set_numeric_standard
 Xp	|bool	|_is_in_locale_category|const bool compiling|const int category
 Apd	|void	|sync_locale
+ApMn	|void	|thread_locale_init
+ApMn	|void	|thread_locale_term
 ApdO	|void	|require_pv	|NN const char* pv
 Apd	|void	|pack_cat	|NN SV *cat|NN const char *pat|NN const char *patend \
 				|NN SV **beglist|NN SV **endlist|NN SV ***next_in_list|U32 flags
@@ -2796,6 +2798,12 @@ s	|void	|new_collate	|NULLOK const char* newcoll
 s	|void	|new_ctype	|NN const char* newctype
 s	|void	|set_numeric_radix|const bool use_locale
 s	|void	|new_numeric	|NULLOK const char* newnum
+#    ifdef USE_POSIX_2008_LOCALE
+sn	|const char*|emulate_setlocale|const int category		\
+				    |NULLOK const char* locale		\
+				    |unsigned int index			\
+				    |const bool is_index_valid
+#    endif
 #    ifdef WIN32
 s	|char*	|win32_setlocale|int category|NULLOK const char* locale
 #    endif
diff --git a/embed.h b/embed.h
index 7d6922b602..6d3a9861f4 100644
--- a/embed.h
+++ b/embed.h
@@ -717,6 +717,8 @@
 #define sync_locale()		Perl_sync_locale(aTHX)
 #define taint_env()		Perl_taint_env(aTHX)
 #define taint_proper(a,b)	Perl_taint_proper(aTHX_ a,b)
+#define thread_locale_init	Perl_thread_locale_init
+#define thread_locale_term	Perl_thread_locale_term
 #define to_uni_lower(a,b,c)	Perl_to_uni_lower(aTHX_ a,b,c)
 #define to_uni_lower_lc(a)	Perl_to_uni_lower_lc(aTHX_ a)
 #define to_uni_title(a,b,c)	Perl_to_uni_title(aTHX_ a,b,c)
@@ -1635,6 +1637,9 @@
 #define new_numeric(a)		S_new_numeric(aTHX_ a)
 #define set_numeric_radix(a)	S_set_numeric_radix(aTHX_ a)
 #define stdize_locale(a)	S_stdize_locale(aTHX_ a)
+#      if defined(USE_POSIX_2008_LOCALE)
+#define emulate_setlocale	S_emulate_setlocale
+#      endif
 #      if defined(WIN32)
 #define win32_setlocale(a,b)	S_win32_setlocale(aTHX_ a,b)
 #      endif
diff --git a/embedvar.h b/embedvar.h
index d8b09fe35b..73c20e7f1b 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -106,6 +106,7 @@
 #define PL_cryptseen		(vTHX->Icryptseen)
 #define PL_curcop		(vTHX->Icurcop)
 #define PL_curcopdb		(vTHX->Icurcopdb)
+#define PL_curlocales		(vTHX->Icurlocales)
 #define PL_curpad		(vTHX->Icurpad)
 #define PL_curpm		(vTHX->Icurpm)
 #define PL_curpm_under		(vTHX->Icurpm_under)
diff --git a/ext/POSIX/lib/POSIX.pod b/ext/POSIX/lib/POSIX.pod
index 712132bd57..c12aaefa63 100644
--- a/ext/POSIX/lib/POSIX.pod
+++ b/ext/POSIX/lib/POSIX.pod
@@ -939,6 +939,7 @@ containing the current underlying locale's formatting values.  Users of this fun
 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
 the underlying locale is C or POSIX.  This is because it otherwise
 changes the locale, which globally affects all threads simultaneously.
diff --git a/intrpvar.h b/intrpvar.h
index dec6fa93c6..466785b882 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -576,7 +576,15 @@ PERLVAR(I, constpadix,	PADOFFSET)	/* lowest unused for constants */
 
 PERLVAR(I, padix_floor,	PADOFFSET)	/* how low may inner block reset padix */
 
+#if defined(USE_POSIX_2008_LOCALE)          \
+ && defined(USE_THREAD_SAFE_LOCALE)         \
+ && ! defined(HAS_QUERYLOCALE)
+
+PERLVARA(I, curlocales, 12, char *)
+
+#endif
 #ifdef USE_LOCALE_COLLATE
+
 PERLVAR(I, collation_name, char *)	/* Name of current collation */
 PERLVAR(I, collxfrm_base, Size_t)	/* Basic overhead in *xfrm() */
 PERLVARI(I, collxfrm_mult,Size_t, 2)	/* Expansion factor in *xfrm() */
diff --git a/locale.c b/locale.c
index 5f68a8e042..595a016927 100644
--- a/locale.c
+++ b/locale.c
@@ -32,6 +32,15 @@
  * the desired behavior of those functions at the moment.  And, LC_MESSAGES is
  * switched to the C locale for outputting the message unless within the scope
  * of 'use locale'.
+ *
+ * This code now has multi-thread-safe locale handling on systems that support
+ * that.  This is completely transparent to most XS code.  On earlier systems,
+ * it would be possible to emulate thread-safe locales, but this likely would
+ * involve a lot of locale switching, and would require XS code changes.
+ * Macros could be written so that the code wouldn't have to know which type of
+ * system is being used.  It's unlikely that we would ever do that, since most
+ * modern systems support thread-safe locales, but there was code written to
+ * this end, and is retained, #ifdef'd out.
  */
 
 #include "EXTERN.h"
@@ -378,16 +387,838 @@ S_category_name(const int category)
 #endif /* ifdef USE_LOCALE */
 
 /* Windows requres a customized base-level setlocale() */
-#  ifdef WIN32
-#    define my_setlocale(cat, locale) win32_setlocale(cat, locale)
+#ifdef WIN32
+#  define my_setlocale(cat, locale) win32_setlocale(cat, locale)
+#else
+#  define my_setlocale(cat, locale) setlocale(cat, locale)
+#endif
+
+#ifndef USE_POSIX_2008_LOCALE
+
+/* "do_setlocale_c" is intended to be called when the category is a constant
+ * known at compile time; "do_setlocale_r", not known until run time  */
+#  define do_setlocale_c(cat, locale) my_setlocale(cat, locale)
+#  define do_setlocale_r(cat, locale) my_setlocale(cat, locale)
+
+#else   /* Below uses POSIX 2008 */
+
+/* We emulate setlocale with our own function.  LC_foo is not valid for the
+ * POSIX 2008 functions.  Instead LC_foo_MASK is used, which we use an array
+ * lookup to convert to.  At compile time we have defined LC_foo_INDEX as the
+ * proper offset into the array 'category_masks[]'.  At runtime, we have to
+ * search through the array (as the actual numbers may not be small contiguous
+ * positive integers which would lend themselves to array lookup). */
+#  define do_setlocale_c(cat, locale)                                       \
+                        emulate_setlocale(cat, locale, cat ## _INDEX, TRUE)
+#  define do_setlocale_r(cat, locale) emulate_setlocale(cat, locale, 0, FALSE)
+
+/* A third array, parallel to the ones above to map from category to its
+ * equivalent mask */
+const int category_masks[] = {
+#  ifdef USE_LOCALE_NUMERIC
+                                LC_NUMERIC_MASK,
+#  endif
+#  ifdef USE_LOCALE_CTYPE
+                                LC_CTYPE_MASK,
+#  endif
+#  ifdef USE_LOCALE_COLLATE
+                                LC_COLLATE_MASK,
+#  endif
+#  ifdef USE_LOCALE_TIME
+                                LC_TIME_MASK,
+#  endif
+#  ifdef USE_LOCALE_MESSAGES
+                                LC_MESSAGES_MASK,
+#  endif
+#  ifdef USE_LOCALE_MONETARY
+                                LC_MONETARY_MASK,
+#  endif
+#  ifdef USE_LOCALE_ADDRESS
+                                LC_ADDRESS_MASK,
+#  endif
+#  ifdef USE_LOCALE_IDENTIFICATION
+                                LC_IDENTIFICATION_MASK,
+#  endif
+#  ifdef USE_LOCALE_MEASUREMENT
+                                LC_MEASUREMENT_MASK,
+#  endif
+#  ifdef USE_LOCALE_PAPER
+                                LC_PAPER_MASK,
+#  endif
+#  ifdef USE_LOCALE_TELEPHONE
+                                LC_TELEPHONE_MASK,
+#  endif
+                                /* LC_ALL can't be turned off by a Configure
+                                 * option, and in Posix 2008, should always be
+                                 * here, so compile it in unconditionally.
+                                 * This could catch some glitches at compile
+                                 * time */
+                                LC_ALL_MASK
+                            };
+
+STATIC const char *
+S_emulate_setlocale(const int category,
+                    const char * locale,
+                    unsigned int index,
+                    const bool is_index_valid
+                   )
+{
+    /* This function effectively performs a setlocale() on just the current
+     * thread; thus it is thread-safe.  It does this by using the POSIX 2008
+     * locale functions to emulate the behavior of setlocale().  Similar to
+     * regular setlocale(), the return from this function points to memory that
+     * can be overwritten by other system calls, so needs to be copied
+     * immediately if you need to retain it.  The difference here is that
+     * system calls besides another setlocale() can overwrite it.
+     *
+     * By doing this, most locale-sensitive functions become thread-safe.  The
+     * exceptions are mostly those that return a pointer to static memory.
+     *
+     * This function takes the same parameters, 'category' and 'locale', that
+     * the regular setlocale() function does, but it also takes two additional
+     * ones.  This is because the 2008 functions don't use a category; instead
+     * they use a corresponding mask.  Because this function operates in both
+     * worlds, it may need one or the other or both.  This function can
+     * calculate the mask from the input category, but to avoid this
+     * calculation, if the caller knows at compile time what the mask is, it
+     * can pass it, setting 'is_index_valid' to TRUE; otherwise the mask
+     * parameter is ignored.
+     *
+     * POSIX 2008, for some sick reason, chose not to provide a method to find
+     * the category name of a locale.  Some vendors have created a
+     * querylocale() function to do just that.  This function is a lot simpler
+     * to implement on systems that have this.  Otherwise, we have to keep
+     * track of what the locale has been set to, so that we can return its
+     * name to emulate setlocale().  It's also possible for C code in some
+     * library to change the locale without us knowing it, though as of
+     * September 2017, there are no occurrences in CPAN of uselocale().  Some
+     * libraries do use setlocale(), but that changes the global locale, and
+     * threads using per-thread locales will just ignore those changes.
+     * Another problem is that without querylocale(), we have to guess at what
+     * was meant by setting a locale of "".  We handle this by not actually
+     * ever setting to "" (unless querylocale exists), but to emulate what we
+     * think should happen for "".
+     */
+
+    int mask;
+    locale_t old_obj;
+    locale_t new_obj;
+    dTHX;
+
+#  ifdef DEBUGGING
+
+    if (DEBUG_Lv_TEST || debug_initialization) {
+        PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale input=%d (%s), \"%s\", %d, %d\n", __FILE__, __LINE__, category, category_name(category), locale, index, is_index_valid);
+    }
+
+#  endif
+
+    /* If the input mask might be incorrect, calculate the correct one */
+    if (! is_index_valid) {
+        unsigned int i;
+
+#  ifdef DEBUGGING
+
+        if (DEBUG_Lv_TEST || debug_initialization) {
+            PerlIO_printf(Perl_debug_log, "%s:%d: finding index of category %d (%s)\n", __FILE__, __LINE__, category, category_name(category));
+        }
+
+#  endif
+
+        for (i = 0; i <= LC_ALL_INDEX; i++) {
+            if (category == categories[i]) {
+                index = i;
+                goto found_index;
+            }
+        }
+
+        /* Here, we don't know about this category, so can't handle it.
+         * Fallback to the early POSIX usages */
+        Perl_warner(aTHX_ packWARN(WARN_LOCALE),
+                            "Unknown locale category %d; can't set it to %s\n",
+                                                     category, locale);
+        return NULL;
+
+      found_index: ;
+
+#  ifdef DEBUGGING
+
+        if (DEBUG_Lv_TEST || debug_initialization) {
+            PerlIO_printf(Perl_debug_log, "%s:%d: index is %d for %s\n", __FILE__, __LINE__, index, category_name(category));
+        }
+
+#  endif
+
+    }
+
+    mask = category_masks[index];
+
+#  ifdef DEBUGGING
+
+    if (DEBUG_Lv_TEST || debug_initialization) {
+        PerlIO_printf(Perl_debug_log, "%s:%d: category name is %s; mask is 0x%x\n", __FILE__, __LINE__, category_names[index], mask);
+    }
+
+#  endif
+
+    /* If just querying what the existing locale is ... */
+    if (locale == NULL) {
+        locale_t cur_obj = uselocale((locale_t) 0);
+
+#  ifdef DEBUGGING
+
+        if (DEBUG_Lv_TEST || debug_initialization) {
+            PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale querying %p\n", __FILE__, __LINE__, cur_obj);
+        }
+
+#  endif
+
+        if (cur_obj == LC_GLOBAL_LOCALE) {
+            return my_setlocale(category, NULL);
+        }
+
+#  ifdef HAS_QUERYLOCALE
+
+        return (char *) querylocale(mask, cur_obj);
+
 #  else
-#    define my_setlocale(cat, locale) setlocale(cat, locale)
+#    if defined(_NL_LOCALE_NAME) && defined(DEBUGGING)
+
+        {
+            /* Internal glibc for querylocale(), but doesn't handle
+             * empty-string ("") locale properly; who knows what other
+             * glitches.  Check it for now, under debug. */
+
+            char * temp_name = nl_langinfo_l(_NL_LOCALE_NAME(category),
+                                             uselocale((locale_t) 0));
+            /*
+            PerlIO_printf(Perl_debug_log, "%s:%d: temp_name=%s\n", __FILE__, __LINE__, temp_name ? temp_name : "NULL");
+            PerlIO_printf(Perl_debug_log, "%s:%d: index=%d\n", __FILE__, __LINE__, index);
+            PerlIO_printf(Perl_debug_log, "%s:%d: PL_curlocales[index]=%s\n", __FILE__, __LINE__, PL_curlocales[index]);
+            */
+            if (temp_name && PL_curlocales[index] && strNE(temp_name, "")) {
+                if (         strNE(PL_curlocales[index], temp_name)
+                    && ! (   isNAME_C_OR_POSIX(temp_name)
+                          && isNAME_C_OR_POSIX(PL_curlocales[index]))) {
+
+#      ifdef USE_C_BACKTRACE
+
+                    dump_c_backtrace(Perl_debug_log, 20, 1);
+
+#      endif
+
+                    Perl_croak(aTHX_ "panic: Mismatch between what Perl thinks %s is"
+                                     " (%s) and what internal glibc thinks"
+                                     " (%s)\n", category_names[index],
+                                     PL_curlocales[index], temp_name);
+                }
+
+                return temp_name;
+            }
+        }
+
+#    endif
+
+        /* Without querylocale(), we have to use our record-keeping we've
+         *  done. */
+
+        if (category != LC_ALL) {
+
+#    ifdef DEBUGGING
+
+            if (DEBUG_Lv_TEST || debug_initialization) {
+                PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale returning %s\n", __FILE__, __LINE__, PL_curlocales[index]);
+            }
+
+#    endif
+
+            return PL_curlocales[index];
+        }
+        else {  /* For LC_ALL */
+            unsigned int i;
+            Size_t names_len = 0;
+            char * all_string;
+
+            /* If we have a valid LC_ALL value, just return it */
+            if (PL_curlocales[LC_ALL_INDEX]) {
+
+#    ifdef DEBUGGING
+
+                if (DEBUG_Lv_TEST || debug_initialization) {
+                    PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale returning %s\n", __FILE__, __LINE__, PL_curlocales[LC_ALL_INDEX]);
+                }
+
+#    endif
+
+                return PL_curlocales[LC_ALL_INDEX];
+            }
+
+            /* Otherwise, we need to construct a string of name=value pairs.
+             * We use the glibc syntax, like
+             *      LC_NUMERIC=C;LC_TIME=en_US.UTF-8;...
+             *  First calculate the needed size. */
+            for (i = 0; i < LC_ALL_INDEX; i++) {
+
+#    ifdef DEBUGGING
+
+                if (DEBUG_Lv_TEST || debug_initialization) {
+                    PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale i=%d, name=%s, locale=%s\n", __FILE__, __LINE__, i, category_names[i], PL_curlocales[i]);
+                }
+
+#    endif
+
+                names_len += strlen(category_names[i])
+                          + 1                       /* '=' */
+                          + strlen(PL_curlocales[i])
+                          + 1;                      /* ';' */
+            }
+            names_len++;    /* Trailing '\0' */
+            SAVEFREEPV(Newx(all_string, names_len, char));
+            *all_string = '\0';
+
+            /* Then fill in the string */
+            for (i = 0; i < LC_ALL_INDEX; i++) {
+
+#    ifdef DEBUGGING
+
+                if (DEBUG_Lv_TEST || debug_initialization) {
+                    PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale i=%d, name=%s, locale=%s\n", __FILE__, __LINE__, i, category_names[i], PL_curlocales[i]);
+                }
+
+#    endif
+
+                my_strlcat(all_string, category_names[i], names_len);
+                my_strlcat(all_string, "=", names_len);
+                my_strlcat(all_string, PL_curlocales[i], names_len);
+                my_strlcat(all_string, ";", names_len);
+            }
+
+#    ifdef DEBUGGING
+
+            if (DEBUG_L_TEST || debug_initialization) {
+                PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale returning %s\n", __FILE__, __LINE__, all_string);
+            }
+
+    #endif
+
+            return all_string;
+        }
+
+#    ifdef EINVAL
+
+        SETERRNO(EINVAL, LIB_INVARG);
+
+#    endif
+
+        return NULL;
+
 #  endif
 
-/* Just placeholders for now.  "_c" is intended to be called when the category
- * is a constant known at compile time; "_r", not known until run time  */
-#  define do_setlocale_c(category, locale) my_setlocale(category, locale)
-#  define do_setlocale_r(category, locale) my_setlocale(category, locale)
+    }
+
+    assert(PL_C_locale_obj);
+
+    /* Otherwise, we are switching locales.  This will generally entail freeing
+     * the current one's space (at the C library's discretion).  We need to
+     * stop using that locale before the switch.  So switch to a known locale
+     * object that we don't otherwise mess with.  This returns the locale
+     * object in effect at the time of the switch. */
+    old_obj = uselocale(PL_C_locale_obj);
+
+#  ifdef DEBUGGING
+
+    if (DEBUG_Lv_TEST || debug_initialization) {
+        PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale was using %p\n", __FILE__, __LINE__, old_obj);
+    }
+
+#  endif
+
+    if (! old_obj) {
+
+#  ifdef DEBUGGING
+
+        if (DEBUG_L_TEST || debug_initialization) {
+            dSAVE_ERRNO;
+            PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale switching to C failed: %d\n", __FILE__, __LINE__, GET_ERRNO);
+            RESTORE_ERRNO;
+        }
+
+#  endif
+
+        return NULL;
+    }
+
+#  ifdef DEBUGGING
+
+    if (DEBUG_Lv_TEST || debug_initialization) {
+        PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale now using %p\n", __FILE__, __LINE__, PL_C_locale_obj);
+    }
+
+#  endif
+
+    /* If we weren't in a thread safe locale, set so that newlocale() below
+     which uses 'old_obj', uses an empty one.  Same for our reserved C object.
+     The latter is defensive coding, so that, even if there is some bug, we
+     will never end up trying to modify either of these, as if passed to
+     newlocale(), they can be. */
+    if (old_obj == LC_GLOBAL_LOCALE || old_obj == PL_C_locale_obj) {
+        old_obj = (locale_t) 0;
+    }
+
+    /* Create the new locale (it may actually modify the current one). */
+
+#  ifndef HAS_QUERYLOCALE
+
+    if (strEQ(locale, "")) {
+
+        /* For non-querylocale() systems, we do the setting of "" ourselves to
+         * be sure that we really know what's going on.  We follow the Linux
+         * documented behavior (but if that differs from the actual behavior,
+         * this won't work exactly as the OS implements).  We go out and
+         * examine the environment based on our understanding of how the system
+         * works, and use that to figure things out */
+
+        const char * const lc_all = PerlEnv_getenv("LC_ALL");
+
+        /* Use any "LC_ALL" environment variable, as it overrides everything
+         * else. */
+        if (lc_all && strNE(lc_all, "")) {
+            locale = lc_all;
+        }
+        else {
+
+            /* Otherwise, we need to dig deeper.  Unless overridden, the
+             * default is the LANG environment variable; if it doesn't exist,
+             * then "C" */
+
+            const char * default_name;
+
+            /* To minimize other threads messing with the environment, we copy
+             * the variable, making it a temporary.  But this doesn't work upon
+             * program initialization before any scopes are created, and at
+             * this time, there's nothing else going on that would interfere.
+             * So skip the copy in that case */
+            if (PL_scopestack_ix == 0) {
+                default_name = PerlEnv_getenv("LANG");
+            }
+            else {
+                default_name = savepv(PerlEnv_getenv("LANG"));
+            }
+
+            if (! default_name || strEQ(default_name, "")) {
+                    default_name = "C";
+            }
+            else if (PL_scopestack_ix != 0) {
+                SAVEFREEPV(default_name);
+            }
+
+            if (category != LC_ALL) {
+                const char * const name = PerlEnv_getenv(category_names[index]);
+
+                /* Here we are setting a single category.  Assume will have the
+                 * default name */
+                locale = default_name;
+
+                /* But then look for an overriding environment variable */
+                if (name && strNE(name, "")) {
+                    locale = name;
+                }
+            }
+            else {
+                bool did_override = FALSE;
+                unsigned int i;
+
+                /* Here, we are getting LC_ALL.  Any categories that don't have
+                 * a corresponding environment variable set should be set to
+                 * LANG, or to "C" if there is no LANG.  If no individual
+                 * categories differ from this, we can just set LC_ALL.  This
+                 * is buggy on systems that have extra categories that we don't
+                 * know about.  If there is an environment variable that sets
+                 * that category, we won't know to look for it, and so our use
+                 * of LANG or "C" improperly overrides it.  On the other hand,
+                 * if we don't do what is done here, and there is no
+                 * environment variable, the category's locale should be set to
+                 * LANG or "C".  So there is no good solution.  khw thinks the
+                 * best is to look at systems to see what categories they have,
+                 * and include them, and then to assume that we know the
+                 * complete set */
+
+                for (i = 0; i < LC_ALL_INDEX; i++) {
+                    const char * const env_override
+                                    = savepv(PerlEnv_getenv(category_names[i]));
+                    const char * this_locale = (   env_override
+                                                && strNE(env_override, ""))
+                                               ? env_override
+                                               : default_name;
+                    emulate_setlocale(categories[i], this_locale, i, TRUE);
+
+                    if (strNE(this_locale, default_name)) {
+                        did_override = TRUE;
+                    }
+
+                    Safefree(env_override);
+                }
+
+                /* If all the categories are the same, we can set LC_ALL to
+                 * that */
+                if (! did_override) {
+                    locale = default_name;
+                }
+                else {
+
+                    /* Here, LC_ALL is no longer valid, as some individual
+                     * categories don't match it.  We call ourselves
+                     * recursively, as that will execute the code that
+                     * generates the proper locale string for this situation.
+                     * We don't do the remainder of this function, as that is
+                     * to update our records, and we've just done that for the
+                     * individual categories in the loop above, and doing so
+                     * would cause LC_ALL to be done as well */
+                    return emulate_setlocale(LC_ALL, NULL, LC_ALL_INDEX, TRUE);
+                }
+            }
+        }
+    }
+    else if (strchr(locale, ';')) {
+
+        /* LC_ALL may actually incude a conglomeration of various categories.
+         * Without querylocale, this code uses the glibc (as of this writing)
+         * syntax for representing that, but that is not a stable API, and
+         * other platforms do it differently, so we have to handle all cases
+         * ourselves */
+
+        const char * s = locale;
+        const char * e = locale + strlen(locale);
+        const char * p = s;
+        const char * category_end;
+        const char * name_start;
+        const char * name_end;
+
+        while (s < e) {
+            unsigned int i;
+
+            /* Parse through the category */
+            while (isWORDCHAR(*p)) {
+                p++;
+            }
+            category_end = p;
+
+            if (*p++ != '=') {
+                Perl_croak(aTHX_
+                    "panic: %s: %d: Unexpected character in locale name '%02X",
+                    __FILE__, __LINE__, *(p-1));
+            }
+
+            /* Parse through the locale name */
+            name_start = p;
+            while (isGRAPH(*p) && *p != ';') {
+                p++;
+            }
+            name_end = p;
+
+            if (*p++ != ';') {
+                Perl_croak(aTHX_
+                    "panic: %s: %d: Unexpected character in locale name '%02X",
+                    __FILE__, __LINE__, *(p-1));
+            }
+
+            /* Find the index of the category name in our lists */
+            for (i = 0; i < LC_ALL_INDEX; i++) {
+
+                /* Keep going if this isn't the index.  The strnNE() avoids a
+                 * Perl_form(), but would fail if ever a category name could be
+                 * a substring of another one, like if there were a
+                 * "LC_TIME_DATE" */
+                if strnNE(s, category_names[i], category_end - s) {
+                    continue;
+                }
+
+                /* If this index is for the single category we're changing, we
+                 * have found the locale to set it to. */
+                if (category == categories[i]) {
+                    locale = Perl_form(aTHX_ "%.*s",
+                                             (int) (name_end - name_start),
+                                             name_start);
+                    goto ready_to_set;
+                }
+
+                if (category == LC_ALL) {
+                    char * individ_locale = Perl_form(aTHX_ "%.*s", (int) (p - s), s);
+                    emulate_setlocale(categories[i], individ_locale, i, TRUE);
+                    Safefree(individ_locale);
+                }
+            }
+
+            s = p;
+        }
+
+        /* Here we have set all the individual categories by recursive calls.
+         * These collectively should have fixed up LC_ALL, so can just query
+         * what that now is */
+        assert(category == LC_ALL);
+
+        return do_setlocale_c(LC_ALL, NULL);
+    }
+
+  ready_to_set: ;
+
+#  endif  /* end of ! querylocale */
+
+    /* Ready to create a new locale by modification of the exising one */
+    new_obj = newlocale(mask, locale, old_obj);
+
+    if (! new_obj) {
+        dSAVE_ERRNO;
+
+#  ifdef DEBUGGING
+
+        if (DEBUG_L_TEST || debug_initialization) {
+            PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale creating new object failed: %d\n", __FILE__, __LINE__, GET_ERRNO);
+        }
+
+#  endif
+
+        if (! uselocale(old_obj)) {
+            SAVE_ERRNO;
+
+#  ifdef DEBUGGING
+
+            if (DEBUG_L_TEST || debug_initialization) {
+                PerlIO_printf(Perl_debug_log, "%s:%d: switching back failed: %d\n", __FILE__, __LINE__, GET_ERRNO);
+            }
+
+#  endif
+
+        }
+        RESTORE_ERRNO;
+        return NULL;
+    }
+
+#  ifdef DEBUGGING
+
+    if (DEBUG_Lv_TEST || debug_initialization) {
+        PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale created %p\n", __FILE__, __LINE__, new_obj);
+    }
+
+#  endif
+
+    /* And switch into it */
+    if (! uselocale(new_obj)) {
+        dSAVE_ERRNO;
+
+#  ifdef DEBUGGING
+
+        if (DEBUG_L_TEST || debug_initialization) {
+            PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale switching to new object failed\n", __FILE__, __LINE__);
+        }
+
+#  endif
+
+        if (! uselocale(old_obj)) {
+
+#  ifdef DEBUGGING
+
+            if (DEBUG_L_TEST || debug_initialization) {
+                PerlIO_printf(Perl_debug_log, "%s:%d: switching back failed: %d\n", __FILE__, __LINE__, GET_ERRNO);
+            }
+
+#  endif
+
+        }
+        freelocale(new_obj);
+        RESTORE_ERRNO;
+        return NULL;
+    }
+
+#  ifdef DEBUGGING
+
+    if (DEBUG_Lv_TEST || debug_initialization) {
+        PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale now using %p\n", __FILE__, __LINE__, new_obj);
+    }
+
+#  endif
+
+    /* We are done, except for updating our records (if the system doesn't keep
+     * them) and in the case of locale "", we don't actually know what the
+     * locale that got switched to is, as it came from the environment.  So
+     * have to find it */
+
+#  ifdef HAS_QUERYLOCALE
+
+    if (strEQ(locale, "")) {
+        locale = querylocale(mask, new_obj);
+    }
+
+#  else
+
+    /* Here, 'locale' is the return value */
+
+    /* Without querylocale(), we have to update our records */
+
+    if (category == LC_ALL) {
+        unsigned int i;
+
+        /* For LC_ALL, we change all individual categories to correspond */
+                              /* PL_curlocales is a parallel array, so has same
+                               * length as 'categories' */
+        for (i = 0; i <= LC_ALL_INDEX; i++) {
+            Safefree(PL_curlocales[i]);
+            PL_curlocales[i] = savepv(locale);
+        }
+    }
+    else {
+
+        /* For a single category, if it's not the same as the one in LC_ALL, we
+         * nullify LC_ALL */
+
+        if (PL_curlocales[LC_ALL_INDEX] && strNE(PL_curlocales[LC_ALL_INDEX], locale)) {
+            Safefree(PL_curlocales[LC_ALL_INDEX]);
+            PL_curlocales[LC_ALL_INDEX] = NULL;
+        }
+
+        /* Then update the category's record */
+        Safefree(PL_curlocales[index]);
+        PL_curlocales[index] = savepv(locale);
+    }
+
+#  endif
+
+    return locale;
+}
+
+#endif /* USE_POSIX_2008_LOCALE */
+
+#if 0   /* Code that was to emulate thread-safe locales on platforms that
+           didn't natively support them */
+
+/* The way this would work is that we would keep a per-thread list of the
+ * correct locale for that thread.  Any operation that was locale-sensitive
+ * would have to be changed so that it would look like this:
+ *
+ *      LOCALE_LOCK;
+ *      setlocale to the correct locale for this operation
+ *      do operation
+ *      LOCALE_UNLOCK
+ *
+ * This leaves the global locale in the most recently used operation's, but it
+ * was locked long enough to get the result.  If that result is static, it
+ * needs to be copied before the unlock.
+ *
+ * Macros could be written like SETUP_LOCALE_DEPENDENT_OP(category) that did
+ * the setup, but are no-ops when not needed, and similarly,
+ * END_LOCALE_DEPENDENT_OP for the tear-down
+ *
+ * But every call to a locale-sensitive function would have to be changed, and
+ * if a module didn't cooperate by using the mutex, things would break.
+ *
+ * This code was abandoned before being completed or tested, and is left as-is
+*/
+
+#  define do_setlocale_c(cat, locale) locking_setlocale(cat, locale, cat ## _INDEX, TRUE)
+#  define do_setlocale_r(cat, locale) locking_setlocale(cat, locale, 0, FALSE)
+
+STATIC char *
+S_locking_setlocale(pTHX_
+                    const int category,
+                    const char * locale,
+                    int index,
+                    const bool is_index_valid
+                   )
+{
+    /* This function kind of performs a setlocale() on just the current thread;
+     * thus it is kind of thread-safe.  It does this by keeping a thread-level
+     * array of the current locales for each category.  Every time a locale is
+     * switched to, it does the switch globally, but updates the thread's
+     * array.  A query as to what the current locale is just returns the
+     * appropriate element from the array, and doesn't actually call the system
+     * setlocale().  The saving into the array is done in an uninterruptible
+     * section of code, so is unaffected by whatever any other threads might be
+     * doing.
+     *
+     * All locale-sensitive operations must work by first starting a critical
+     * section, then switching to the thread's locale as kept by this function,
+     * and then doing the operation, then ending the critical section.  Thus,
+     * each gets done in the appropriate locale. simulating thread-safety.
+     *
+     * This function takes the same parameters, 'category' and 'locale', that
+     * the regular setlocale() function does, but it also takes two additional
+     * ones.  This is because as described earlier.  If we know on input the
+     * index corresponding to the category into the array where we store the
+     * current locales, we don't have to calculate it.  If the caller knows at
+     * compile time what the index is, it it can pass it, setting
+     * 'is_index_valid' to TRUE; otherwise the index parameter is ignored.
+     *
+     */
+
+    /* If the input index might be incorrect, calculate the correct one */
+    if (! is_index_valid) {
+        unsigned int i;
+
+        if (DEBUG_Lv_TEST || debug_initialization) {
+            PerlIO_printf(Perl_debug_log, "%s:%d: converting category %d to index\n", __FILE__, __LINE__, category);
+        }
+
+        for (i = 0; i <= LC_ALL_INDEX; i++) {
+            if (category == categories[i]) {
+                index = i;
+                goto found_index;
+            }
+        }
+
+        /* Here, we don't know about this category, so can't handle it.
+         * XXX best we can do is to unsafely set this
+         * XXX warning */
+
+        return my_setlocale(category, locale);
+
+      found_index: ;
+
+        if (DEBUG_Lv_TEST || debug_initialization) {
+            PerlIO_printf(Perl_debug_log, "%s:%d: index is 0x%x\n", __FILE__, __LINE__, index);
+        }
+    }
+
+    /* For a query, just return what's in our records */
+    if (new_locale == NULL) {
+        return curlocales[index];
+    }
+
+
+    /* Otherwise, we need to do the switch, and save the result, all in a
+     * critical section */
+
+    Safefree(curlocales[[index]]);
+
+    /* It might be that this is called from an already-locked section of code.
+     * We would have to detect and skip the LOCK/UNLOCK if so */
+    LOCALE_LOCK;
+
+    curlocales[index] = savepv(my_setlocale(category, new_locale));
+
+    if (strEQ(new_locale, "")) {
+
+#ifdef LC_ALL
+
+        /* The locale values come from the environment, and may not all be the
+         * same, so for LC_ALL, we have to update all the others, while the
+         * mutex is still locked */
+
+        if (category == LC_ALL) {
+            unsigned int i;
+            for (i = 0; i < LC_ALL_INDEX) {
+                curlocales[i] = my_setlocale(categories[i], NULL);
+            }
+        }
+    }
+
+#endif
+
+    LOCALE_UNLOCK;
+
+    return curlocales[index];
+}
+
+#endif
 
 STATIC void
 S_set_numeric_radix(pTHX_ const bool use_locale)
@@ -1216,14 +2047,21 @@ returns the correct underlying C<LC_NUMERIC> locale, instead of C<C> always, as
 perl keeps that locale category as C<C>, changing it briefly during the
 operations where the underlying one is required.
 
-The other reason it isn't completely a drop-in replacement is that it is
+Another reason it isn't completely a drop-in replacement is that it is
 declared to return S<C<const char *>>, whereas the system setlocale omits the
 C<const>.  (If it were being written today, plain setlocale would be declared
 const, since it is illegal to change the information it returns; doing so leads
 to segfaults.)
 
+Finally, C<Perl_setlocale> works under all circumstances, whereas plain
+C<setlocale> can be completely ineffective on some platforms under some
+configurations.
+
 C<Perl_setlocale> should not be used to change the locale except on systems
-where the predefined variable C<${^SAFE_LOCALES}> is 1.
+where the predefined variable C<${^SAFE_LOCALES}> is 1.  On some such systems,
+the system C<setlocale()> is ineffective, returning the wrong information, and
+failing to actually change the locale.  C<Perl_setlocale>, however works
+properly in all circumstances.
 
 The return points to a per-thread static buffer, which is overwritten the next
 time C<Perl_setlocale> is called from the same thread.
@@ -2124,51 +2962,87 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 #    ifdef USE_LOCALE_NUMERIC
     assert(categories[LC_NUMERIC_INDEX] == LC_NUMERIC);
     assert(strEQ(category_names[LC_NUMERIC_INDEX], "LC_NUMERIC"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_NUMERIC_INDEX] == LC_NUMERIC_MASK);
+#      endif
 #    endif
 #    ifdef USE_LOCALE_CTYPE
     assert(categories[LC_CTYPE_INDEX] == LC_CTYPE);
     assert(strEQ(category_names[LC_CTYPE_INDEX], "LC_CTYPE"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_CTYPE_INDEX] == LC_CTYPE_MASK);
+#      endif
 #    endif
 #    ifdef USE_LOCALE_COLLATE
     assert(categories[LC_COLLATE_INDEX] == LC_COLLATE);
     assert(strEQ(category_names[LC_COLLATE_INDEX], "LC_COLLATE"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_COLLATE_INDEX] == LC_COLLATE_MASK);
+#      endif
 #    endif
 #    ifdef USE_LOCALE_TIME
     assert(categories[LC_TIME_INDEX] == LC_TIME);
     assert(strEQ(category_names[LC_TIME_INDEX], "LC_TIME"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_TIME_INDEX] == LC_TIME_MASK);
+#      endif
 #    endif
 #    ifdef USE_LOCALE_MESSAGES
     assert(categories[LC_MESSAGES_INDEX] == LC_MESSAGES);
     assert(strEQ(category_names[LC_MESSAGES_INDEX], "LC_MESSAGES"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_MESSAGES_INDEX] == LC_MESSAGES_MASK);
+#      endif
 #    endif
 #    ifdef USE_LOCALE_MONETARY
     assert(categories[LC_MONETARY_INDEX] == LC_MONETARY);
     assert(strEQ(category_names[LC_MONETARY_INDEX], "LC_MONETARY"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_MONETARY_INDEX] == LC_MONETARY_MASK);
+#      endif
 #    endif
 #    ifdef USE_LOCALE_ADDRESS
     assert(categories[LC_ADDRESS_INDEX] == LC_ADDRESS);
     assert(strEQ(category_names[LC_ADDRESS_INDEX], "LC_ADDRESS"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_ADDRESS_INDEX] == LC_ADDRESS_MASK);
+#      endif
 #    endif
 #    ifdef USE_LOCALE_IDENTIFICATION
     assert(categories[LC_IDENTIFICATION_INDEX] == LC_IDENTIFICATION);
     assert(strEQ(category_names[LC_IDENTIFICATION_INDEX], "LC_IDENTIFICATION"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_IDENTIFICATION_INDEX] == LC_IDENTIFICATION_MASK);
+#      endif
 #    endif
 #    ifdef USE_LOCALE_MEASUREMENT
     assert(categories[LC_MEASUREMENT_INDEX] == LC_MEASUREMENT);
     assert(strEQ(category_names[LC_MEASUREMENT_INDEX], "LC_MEASUREMENT"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_MEASUREMENT_INDEX] == LC_MEASUREMENT_MASK);
+#      endif
 #    endif
 #    ifdef USE_LOCALE_PAPER
     assert(categories[LC_PAPER_INDEX] == LC_PAPER);
     assert(strEQ(category_names[LC_PAPER_INDEX], "LC_PAPER"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_PAPER_INDEX] == LC_PAPER_MASK);
+#      endif
 #    endif
 #    ifdef USE_LOCALE_TELEPHONE
     assert(categories[LC_TELEPHONE_INDEX] == LC_TELEPHONE);
     assert(strEQ(category_names[LC_TELEPHONE_INDEX], "LC_TELEPHONE"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_TELEPHONE_INDEX] == LC_TELEPHONE_MASK);
+#      endif
 #    endif
 #    ifdef LC_ALL
     assert(categories[LC_ALL_INDEX] == LC_ALL);
     assert(strEQ(category_names[LC_ALL_INDEX], "LC_ALL"));
     assert(NOMINAL_LC_ALL_INDEX == LC_ALL_INDEX);
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_ALL_INDEX] == LC_ALL_MASK);
+#      endif
 #    endif
 #  endif    /* DEBUGGING */
 
@@ -2177,8 +3051,34 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
     my_strlcpy(PL_locale_utf8ness, C_and_POSIX_utf8ness,
                sizeof(PL_locale_utf8ness));
 
+#  ifdef USE_THREAD_SAFE_LOCALE
+#    ifdef WIN32
+
+    _configthreadlocale(_ENABLE_PER_THREAD_LOCALE);
+
+#    endif
+#  endif
+#  if defined(LC_ALL_MASK) && defined(HAS_POSIX_2008_LOCALE)
+
+    PL_C_locale_obj = newlocale(LC_ALL_MASK, "C", (locale_t) 0);
+    if (! PL_C_locale_obj) {
+        Perl_croak_nocontext(
+            "panic: Cannot create POSIX 2008 C locale object; errno=%d", errno);
+    }
+    if (DEBUG_Lv_TEST || debug_initialization) {
+        PerlIO_printf(Perl_debug_log, "%s:%d: created C object %p\n", __FILE__, __LINE__, PL_C_locale_obj);
+    }
+
+#  endif
+
     PL_numeric_radix_sv = newSVpvs(".");
 
+#  if defined(USE_POSIX_2008_LOCALE) && ! defined(HAS_QUERYLOCALE)
+
+    /* Initialize our records.  If we have POSIX 2008, we have LC_ALL */
+    do_setlocale_c(LC_ALL, my_setlocale(LC_ALL, NULL));
+
+#  endif
 #  ifdef LOCALE_ENVIRON_REQUIRED
 
     /*
@@ -2537,11 +3437,12 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 
     for (i = 0; i < NOMINAL_LC_ALL_INDEX; i++) {
 
-#  if defined(USE_ITHREADS)
+#  if defined(USE_ITHREADS) && ! defined(USE_THREAD_SAFE_LOCALE)
 
         /* This caches whether each category's locale is UTF-8 or not.  This
          * may involve changing the locale.  It is ok to do this at
-         * initialization time before any threads have started, but not later.
+         * initialization time before any threads have started, but not later
+         * unless thread-safe operations are used.
          * Caching means that if the program heeds our dictate not to change
          * locales in threaded applications, this data will remain valid, and
          * it may get queried without having to change locales.  If the
@@ -3972,45 +4873,18 @@ Perl_my_strerror(pTHX_ const int errnum)
 #    endif
 #  else /* Doesn't have strerror_l() */
 
-#    ifdef USE_POSIX_2008_LOCALE
-
-    locale_t save_locale = NULL;
-
-#    else
-
     const char * save_locale = NULL;
     bool locale_is_C = FALSE;
 
     /* We have a critical section to prevent another thread from executing this
-     * same code at the same time.  (On unthreaded perls, the LOCK is a
+     * same code at the same time.  (On thread-safe perls, the LOCK is a
      * no-op.)  Since this is the only place in core that changes LC_MESSAGES
      * (unless the user has called setlocale(), this works to prevent races. */
     LOCALE_LOCK;
 
-#    endif
-
     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
                             "my_strerror called with errnum %d\n", errnum));
     if (! within_locale_scope) {
-        errno = 0;
-
-#  ifdef USE_POSIX_2008_LOCALE /* Use the thread-safe locale functions */
-
-        DEBUG_Lv(PerlIO_printf(Perl_debug_log,
-                                    "Not within locale scope, about to call"
-                                    " uselocale(0x%p)\n", PL_C_locale_obj));
-        save_locale = uselocale(PL_C_locale_obj);
-        if (! save_locale) {
-            DEBUG_L(PerlIO_printf(Perl_debug_log,
-                                    "uselocale failed, errno=%d\n", errno));
-        }
-        else {
-            DEBUG_Lv(PerlIO_printf(Perl_debug_log,
-                                    "uselocale returned 0x%p\n", save_locale));
-        }
-
-#    else    /* Not thread-safe build */
-
         save_locale = do_setlocale_c(LC_MESSAGES, NULL);
         if (! save_locale) {
             Perl_croak(aTHX_
@@ -4029,9 +4903,6 @@ Perl_my_strerror(pTHX_ const int errnum)
                 do_setlocale_c(LC_MESSAGES, "C");
             }
         }
-
-#    endif
-
     }   /* end of ! within_locale_scope */
     else {
         DEBUG_Lv(PerlIO_printf(Perl_debug_log, "%s: %d: WITHIN locale scope\n",
@@ -4043,21 +4914,6 @@ Perl_my_strerror(pTHX_ const int errnum)
     errstr = savepv(Strerror(errnum));
 
     if (! within_locale_scope) {
-        errno = 0;
-
-#  ifdef USE_POSIX_2008_LOCALE
-
-        DEBUG_Lv(PerlIO_printf(Perl_debug_log,
-                    "%s: %d: not within locale scope, restoring the locale\n",
-                    __FILE__, __LINE__));
-        if (save_locale && ! uselocale(save_locale)) {
-            DEBUG_L(PerlIO_printf(Perl_debug_log,
-                          "uselocale restore failed, errno=%d\n", errno));
-        }
-    }
-
-#    else
-
         if (save_locale && ! locale_is_C) {
             if (! do_setlocale_c(LC_MESSAGES, save_locale)) {
                 Perl_croak(aTHX_
@@ -4070,7 +4926,6 @@ Perl_my_strerror(pTHX_ const int errnum)
 
     LOCALE_UNLOCK;
 
-#    endif
 #  endif /* End of doesn't have strerror_l */
 #endif   /* End of does have locale messages */
 
@@ -4103,7 +4958,7 @@ to do so, before returning to Perl.
 void
 Perl_sync_locale(pTHX)
 {
-    char * newlocale;
+    const char * newlocale;
 
 #ifdef USE_LOCALE_CTYPE
 
@@ -4188,6 +5043,58 @@ S_setlocale_debug_string(const int category,        /* category number,
 
 #endif
 
+void
+Perl_thread_locale_init()
+{
+    /* Called from a thread on startup*/
+
+#ifdef USE_THREAD_SAFE_LOCALE
+
+    dTHX_DEBUGGING;
+
+    /* C starts the new thread in the global C locale.  If we are thread-safe,
+     * we want to not be in the global locale */
+
+     DEBUG_L(PerlIO_printf(Perl_debug_log,
+            "%s:%d: new thread, initial locale is %s; calling setlocale\n",
+            __FILE__, __LINE__, setlocale(LC_ALL, NULL)));
+
+#  ifdef WIN32
+
+    _configthreadlocale(_ENABLE_PER_THREAD_LOCALE);
+
+#  else
+
+    Perl_setlocale(LC_ALL, "C");
+
+#  endif
+#endif
+
+}
+
+void
+Perl_thread_locale_term()
+{
+    /* Called from a thread as it gets ready to terminate */
+
+#ifdef USE_THREAD_SAFE_LOCALE
+
+    /* C starts the new thread in the global C locale.  If we are thread-safe,
+     * we want to not be in the global locale */
+
+#  ifndef WIN32
+
+    {   /* Free up */
+        locale_t cur_obj = uselocale(LC_GLOBAL_LOCALE);
+        if (cur_obj != LC_GLOBAL_LOCALE) {
+            freelocale(cur_obj);
+        }
+    }
+
+#  endif
+#endif
+
+}
 
 /*
  * ex: set ts=8 sts=4 sw=4 et:
diff --git a/makedef.pl b/makedef.pl
index aa3d8c48ee..06c647fc2c 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -360,6 +360,7 @@ unless ($define{'USE_ITHREADS'}) {
     ++$skip{$_} foreach qw(
                     PL_keyword_plugin_mutex
 		    PL_check_mutex
+                    PL_curlocales
 		    PL_op_mutex
 		    PL_regex_pad
 		    PL_regex_padav
diff --git a/perl.c b/perl.c
index a638baeeb7..70dc823040 100644
--- a/perl.c
+++ b/perl.c
@@ -1146,7 +1146,14 @@ perl_destruct(pTHXx)
     Safefree(PL_collation_name);
     PL_collation_name = NULL;
 #endif
-
+#if   defined(USE_POSIX_2008_LOCALE)      \
+ &&   defined(USE_THREAD_SAFE_LOCALE)     \
+ && ! defined(HAS_QUERYLOCALE)
+    for (i = 0; i < (int) C_ARRAY_LENGTH(PL_curlocales); i++) {
+        Safefree(PL_curlocales[i]);
+        PL_curlocales[i] = NULL;
+    }
+#endif
 #ifdef USE_LOCALE_NUMERIC
     Safefree(PL_numeric_name);
     PL_numeric_name = NULL;
diff --git a/perl.h b/perl.h
index 9d0eab0fe1..ff6c882551 100644
--- a/perl.h
+++ b/perl.h
@@ -759,7 +759,6 @@
 #endif /* !NO_LOCALE && HAS_SETLOCALE */
 
 #ifdef USE_LOCALE /* These locale things are all subject to change */
-
 #  if      defined(HAS_NEWLOCALE)               \
       &&   defined(LC_ALL_MASK)                 \
       &&   defined(HAS_FREELOCALE)              \
@@ -772,6 +771,15 @@
 
 #    define HAS_POSIX_2008_LOCALE
 #  endif
+#  if     defined(USE_ITHREADS)                                             \
+      && (    defined(HAS_POSIX_2008_LOCALE)                                \
+          || (defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1400))     \
+      && ! defined(NO_THREAD_SAFE_LOCALE)
+#    define USE_THREAD_SAFE_LOCALE
+#    ifdef HAS_POSIX_2008_LOCALE
+#      define USE_POSIX_2008_LOCALE
+#    endif
+#  endif
 #endif
 
 #include <setjmp.h>
@@ -5651,10 +5659,6 @@ typedef struct am_table_short AMTS;
                         MUTEX_DESTROY(&PL_lc_numeric_mutex);                \
                         _LOCALE_TERM_POSIX_2008;                            \
                     } STMT_END
-#    ifdef HAS_POSIX_2008_LOCALE
-#      define USE_POSIX_2008_LOCALE
-#      define USE_THREAD_SAFE_LOCALE
-#    endif
 #  endif
 
 /* Returns TRUE if the plain locale pragma without a parameter is in effect
@@ -5804,8 +5808,9 @@ argument list, like this:
 The private variable is used to save the current locale state, so
 that the requisite matching call to L</RESTORE_LC_NUMERIC> can restore it.
 
-On threaded perls, this macro uses a mutex to force a critical section.
-Therefore the matching RESTORE should be close by, and guaranteed to be called.
+On threaded perls not operating with thread-safe functionality, this macro uses
+a mutex to force a critical section.  Therefore the matching RESTORE should be
+close by, and guaranteed to be called.
 
 =for apidoc Am|void|STORE_LC_NUMERIC_SET_TO_NEEDED
 
@@ -5837,8 +5842,9 @@ argument list, like this:
      ...
  }
 
-On threaded perls, this macro uses a mutex to force a critical section.
-Therefore the matching RESTORE should be close by, and guaranteed to be called.
+On threaded perls not operating with thread-safe functionality, this macro uses
+a mutex to force a critical section.  Therefore the matching RESTORE should be
+close by, and guaranteed to be called.
 
 =for apidoc Am|void|RESTORE_LC_NUMERIC
 
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index b610dcf2a8..c726a631a6 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -7291,6 +7291,14 @@ a range.  For these, what should happen isn't clear at all.  In
 these circumstances, Perl discards all but the first character
 of the returned sequence, which is not likely what you want.
 
+=item Unknown locale category %d; can't set it to %s
+
+(W locale) You used a locale category that perl doesn't recognize, so it
+cannot carry out your request.  Check that you are using a valid
+category.  If so, see L<perllocale/Multi-threaded> for advice on
+reporting this as a bug, and for modifying perl locally to accommodate
+your needs.
+
 =item Using /u for '%s' instead of /%s in regex; marked by S<<-- HERE> in m/%s/
 
 (W regexp) You used a Unicode boundary (C<\b{...}> or C<\B{...}>) in a
diff --git a/pod/perlembed.pod b/pod/perlembed.pod
index 2196ad8094..d6391f7a26 100644
--- a/pod/perlembed.pod
+++ b/pod/perlembed.pod
@@ -1108,6 +1108,11 @@ C pre-processor symbol C<HAS_SKIP_LOCALE_INIT>.  This allows code that
 has to work with multiple Perl versions to do some sort of work-around
 when confronted with an earlier Perl.
 
+If your program is using the POSIX 2008 multi-thread locale
+functionality, you should switch into the global locale and set that up
+properly before starting the Perl interpreter.  It will then properly
+switch back to using the thread-safe functions.
+
 =head1 Hiding Perl_
 
 If you completely hide the short forms of the Perl public API,
diff --git a/pod/perllocale.pod b/pod/perllocale.pod
index 233aaeba1a..52266a114a 100644
--- a/pod/perllocale.pod
+++ b/pod/perllocale.pod
@@ -171,14 +171,17 @@ L</The setlocale function>.
 
 =head2 The C<"use locale"> pragma
 
-WARNING!  Do NOT use this pragma in scripts that have multiple
-L<threads|threads> active.  The locale is not local to a single thread.
-Another thread may change the locale at any time, which could cause at a
-minimum that a given thread is operating in a locale it isn't expecting
-to be in.  On some platforms, segfaults can also occur.  The locale
-change need not be explicit; some operations cause perl to change the
-locale itself.  You are vulnerable simply by having done a S<C<"use
-locale">>.
+Starting in Perl 5.28, this pragma may be used in
+L<multi-threaded|threads> applications on systems that have thread-safe
+locale ability.  Some caveats apply, see L</Multi-threaded> below.  On
+systems without this capability, or in earlier Perls, do NOT use this
+pragma in scripts that have multiple L<threads|threads> active.  The
+locale in these cases is not local to a single thread.  Another thread
+may change the locale at any time, which could cause at a minimum that a
+given thread is operating in a locale it isn't expecting to be in.  On
+some platforms, segfaults can also occur.  The locale change need not be
+explicit; some operations cause perl to change the locale itself.  You
+are vulnerable simply by having done a S<C<"use locale">>.
 
 By default, Perl itself (outside the L<POSIX> module)
 ignores the current locale.  The S<C<use locale>>
@@ -369,7 +372,7 @@ will be locale aware.  Everything else is unaffected.
 Since Perl doesn't currently do anything with the C<LC_MONETARY>
 category, specifying C<:monetary> does effectively nothing.  Some
 systems have other categories, such as C<LC_PAPER>, but Perl
-also doesn't know anything about them, and there is no way to specify
+also doesn't do anything with them, and there is no way to specify
 them in this pragma's arguments.
 
 You can also easily say to use all categories but one, by either, for
@@ -407,12 +410,13 @@ this, as described in L</Unicode and UTF-8>.
 
 =head2 The setlocale function
 
-WARNING!  Do NOT use this function in a L<thread|threads>.  The locale
-will change in all other threads at the same time, and should your
-thread get paused by the operating system, and another started, that
-thread will not have the locale it is expecting.  On some platforms,
-there can be a race leading to segfaults if two threads call this
-function nearly simultaneously.
+WARNING!  Prior to Perl 5.28 or on a system that does not support
+thread-safe locale operations, do NOT use this function in a
+L<thread|threads>.  The locale will change in all other threads at the
+same time, and should your thread get paused by the operating system,
+and another started, that thread will not have the locale it is
+expecting.  On some platforms, there can be a race leading to segfaults
+if two threads call this function nearly simultaneously.
 
 You can switch locales as often as you wish at run time with the
 C<POSIX::setlocale()> function:
@@ -485,9 +489,59 @@ If C<set_locale()> fails for some reason (for example, an attempt to set
 to a locale unknown to the system), the locale for the category is not
 changed, and the function returns C<undef>.
 
+Starting in Perl 5.28, on multi-threaded perls compiled on systems that
+implement POSIX 2008 thread-safe locale operations, this function
+doesn't actually call the system C<setlocale>.  Instead those
+thread-safe operations are used to emulate the C<setlocale> function,
+but in a thread-safe manner.
 
 For further information about the categories, consult L<setlocale(3)>.
 
+=head2 Multi-threaded operation
+
+Beginning in Perl 5.28, multi-threaded locale operation is supported on
+systems that implement either the POSIX 2008 or Windows-specific
+thread-safe locale operations.  Many modern systems, such as various
+Unix variants and Darwin do have this.
+
+You can tell if using locales is safe on your system by looking at the
+read-only boolean variable C<${^SAFE_LOCALES}>.  The value is 1 if the
+perl is not threaded, or if it is using thread-safe locale operations.
+
+Thread-safe operations are supported in Windows starting in Visual Studio
+2005, and in systems compatible with POSIX 2008.  Some platforms claim
+to support POSIX 2008, but have buggy implementations, so that the hints
+files for compiling to run on them turn off attempting to use
+thread-safety.  C<${^SAFE_LOCALES}> will be 0 on them.
+
+Be aware that writing a multi-threaded application will not be portable
+to a platform which lacks the native thread-safe locale support.  On
+systems that do have it, you automatically get this behavior for
+threaded perls, without having to do anything.  If for some reason, you
+don't want to use this capability (perhaps the POSIX 2008 support is
+buggy on your system), you can manually compile Perl to use the old
+non-thread-safe implementation by passing the argument
+C<-Accflags='-DNO_THREAD_SAFE_LOCALE'> to F<Configure>.
+Except on Windows, this will continue to use certain of the POSIX 2008
+functions in some situations.  If these are buggy, you can pass the
+following to F<Configure> instead or additionally:
+C<-Accflags='-DNO_POSIX_2008_LOCALE'>.  This will also keep the code
+from using thread-safe locales.
+C<${^SAFE_LOCALES}> will be 0 on systems that turn off the thread-safe
+operations.
+
+The initial program is started up using the locale specified from the
+environment, as currently, described in L</ENVIRONMENT>.   All newly
+created threads start with C<LC_ALL> set to C<"C">>.  Each thread may
+use C<POSIX::setlocale()> to query or switch its locale at any time,
+without affecting any other thread.  All locale-dependent operations
+automatically use their thread's locale.
+
+This should be completely transparent to any applications written
+entirely in Perl (minus a few rarely encountered caveats given in the
+L</Multi-threaded> section).  Information for XS module writers is given
+in L<perlxs/Locale-aware XS code>.
+
 =head2 Finding locales
 
 For locales available in your system, consult also L<setlocale(3)> to
@@ -1433,12 +1487,10 @@ the same way, "localization" is often abbreviated to B<l10n>.
 =head2 An imperfect standard
 
 Internationalization, as defined in the C and POSIX standards, can be
-criticized as incomplete, ungainly, and having too large a granularity.
-(Locales apply to a whole process, when it would arguably be more useful
-to have them apply to a single thread, window group, or whatever.)  They
-also have a tendency, like standards groups, to divide the world into
-nations, when we all know that the world can equally well be divided
-into bankers, bikers, gamers, and so on.
+criticized as incomplete and ungainly.  They also have a tendency, like
+standards groups, to divide the world into nations, when we all know
+that the world can equally well be divided into bankers, bikers, gamers,
+and so on.
 
 =head1 Unicode and UTF-8
 
@@ -1609,6 +1661,50 @@ control, but doesn't.  If two strings do collate identically, the one
 containing the C<NUL> will sort to earlier.  Prior to 5.26, there were
 more bugs.
 
+=head2 Multi-threaded
+
+XS code or C-language libraries called from it that use the system
+L<C<setlocale(3)>> function (except on Windows) likely will not work
+from a multi-threaded application without changes.  See
+L<perlxs/Locale-aware XS code>.
+
+An XS module that is locale-dependent could have been written under the
+assumption that it will never be called in a multi-threaded environment,
+and so uses other non-locale constructs that aren't multi-thread-safe.
+See L<perlxs/Thread-aware system interfaces>.
+
+POSIX does not define a way to get the name of the current per-thread
+locale.  Some systems, such as Darwin and NetBSD do implement a
+function, L<querylocale(3)> to do this.  On non-Windows systems without
+it, such as Linux, there are some additional caveats:
+
+=over
+
+=item *
+
+An embedded perl needs to be started up while the global locale is in
+effect.  See L<perlembed/Using embedded Perl with POSIX locales>.
+
+=item *
+
+It becomes more important for perl to know about all the possible
+locale categories on the platform, even if they aren't apparently used
+in your program.  Perl knows all of the Linux ones.  If your platform
+has others, you can send email to L<mailto:perlbug@perl.org> for
+inclusion of it in the next release.  In the meantime, it is possible to
+edit the Perl source to teach it about the category, and then recompile.
+Search for instances of, say, C<LC_PAPER> in the source, and use that as
+a template to add the omitted one.
+
+=item *
+
+It is possible, though hard to do, to call C<POSIX::setlocale> with a
+locale that it doesn't recognize as syntactically legal, but actually is
+legal on that system.  This should happen only with embedded perls, or
+if you hand-craft a locale name yourself.
+
+=back
+
 =head2 Broken systems
 
 In certain systems, the operating system's locale support
diff --git a/pod/perlvar.pod b/pod/perlvar.pod
index 8f99c406fc..06d1ef9a93 100644
--- a/pod/perlvar.pod
+++ b/pod/perlvar.pod
@@ -2264,7 +2264,11 @@ X<${^SAFE_LOCALES}>
 
 Reflects if safe locale operations are available to this perl (when the
 value is 1) or not (the value is 0).  This variable is always 1 if the
-perl has been compiled without threads, and currently 0 otherwise.
+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
+set to 1 in such threads.
 
 This variable is read-only.
 
diff --git a/proto.h b/proto.h
index 7853874e85..920d625709 100644
--- a/proto.h
+++ b/proto.h
@@ -3525,6 +3525,8 @@ PERL_CALLCONV void	Perl_taint_env(pTHX);
 PERL_CALLCONV void	Perl_taint_proper(pTHX_ const char* f, const char *const s);
 #define PERL_ARGS_ASSERT_TAINT_PROPER	\
 	assert(s)
+PERL_CALLCONV void	Perl_thread_locale_init(void);
+PERL_CALLCONV void	Perl_thread_locale_term(void);
 PERL_CALLCONV OP *	Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv, const MAGIC *const mg, const U32 flags, U32 argc, ...);
 #define PERL_ARGS_ASSERT_TIED_METHOD	\
 	assert(methname); assert(sp); assert(sv); assert(mg)
@@ -4713,6 +4715,9 @@ STATIC void	S_set_numeric_radix(pTHX_ const bool use_locale);
 STATIC char*	S_stdize_locale(pTHX_ char* locs);
 #define PERL_ARGS_ASSERT_STDIZE_LOCALE	\
 	assert(locs)
+#    if defined(USE_POSIX_2008_LOCALE)
+STATIC const char*	S_emulate_setlocale(const int category, const char* locale, unsigned int index, const bool is_index_valid);
+#    endif
 #    if defined(WIN32)
 STATIC char*	S_win32_setlocale(pTHX_ int category, const char* locale);
 #    endif
diff --git a/sv.c b/sv.c
index 2c3da0fb7f..1aa5966489 100644
--- a/sv.c
+++ b/sv.c
@@ -15549,6 +15549,13 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_subname		= sv_dup_inc(proto_perl->Isubname, param);
 
+#if   defined(USE_POSIX_2008_LOCALE)      \
+ &&   defined(USE_THREAD_SAFE_LOCALE)     \
+ && ! defined(HAS_QUERYLOCALE)
+    for (i = 0; i < (int) C_ARRAY_LENGTH(PL_curlocales); i++) {
+        PL_curlocales[i] = savepv("."); /* An illegal value */
+    }
+#endif
 #ifdef USE_LOCALE_CTYPE
     /* Should we warn if uses locale? */
     PL_warn_locale      = sv_dup_inc(proto_perl->Iwarn_locale, param);
diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat
index 7545ccf888..78e0ec659d 100644
--- a/t/porting/known_pod_issues.dat
+++ b/t/porting/known_pod_issues.dat
@@ -240,6 +240,7 @@ provide
 ptar(1)
 ptargrep(1)
 pwd_mkdb(8)
+querylocale(3)
 RDF::Trine
 read(2)
 Readonly
diff --git a/vutil.c b/vutil.c
index af5f263be7..a66d6ef2f4 100644
--- a/vutil.c
+++ b/vutil.c
@@ -625,7 +625,11 @@ VER_NV:
              * locales without letting perl know, therefore we have to find it
              * from first principals.  See [perl #121930]. */
 
-            /* if it isn't C, set it to C. */
+            /* In windows, or not threaded, or not thread-safe, if it isn't C,
+             * set it to C. */
+
+#  ifndef USE_POSIX_2008_LOCALE
+
             const char * locale_name_on_entry;
 
             LC_NUMERIC_LOCK(0);    /* Start critical section */
@@ -641,6 +645,48 @@ VER_NV:
                 locale_name_on_entry = NULL;
             }
 
+# else
+
+            const locale_t locale_obj_on_entry = uselocale((locale_t) 0);
+            const char * locale_name_on_entry = NULL;
+            DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+
+            if (locale_obj_on_entry == LC_GLOBAL_LOCALE) {
+
+                /* in the global locale, we can call system setlocale and if it
+                 * isn't C, set it to C. */
+                LC_NUMERIC_LOCK(0);
+
+                locale_name_on_entry = setlocale(LC_NUMERIC, NULL);
+                if (   strNE(locale_name_on_entry, "C")
+                    && strNE(locale_name_on_entry, "POSIX"))
+                {
+                    setlocale(LC_NUMERIC, "C");
+                }
+                else {  /* This value indicates to the restore code that we
+                           didn't change the locale */
+                    locale_name_on_entry = NULL;
+                }
+            }
+            else if (locale_obj_on_entry == PL_underlying_numeric_obj) {
+                /* Here, the locale appears to have been changed to use the
+                 * program's underlying locale.  Just use our mechanisms to
+                 * switch back to C.   It might be possible for this pointer to
+                 * actually refer to something else if it got released and
+                 * reused somehow.  But it doesn't matter, our mechanisms will
+                 * work even so */
+                STORE_LC_NUMERIC_SET_STANDARD();
+            }
+            else if (locale_obj_on_entry != PL_C_locale_obj) {
+                /* The C object should be unchanged during a program's
+                 * execution, so it should be safe to assume it means what it
+                 * says, so if we are in it, no locale change is required.
+                 * Otherwise, simply use the thread-safe operation. */
+                uselocale(PL_C_locale_obj);
+            }
+
+# endif
+
             /* Prevent recursed calls from trying to change back */
             LOCK_LC_NUMERIC_STANDARD();
 
@@ -660,12 +706,29 @@ VER_NV:
 
             UNLOCK_LC_NUMERIC_STANDARD();
 
+#  ifndef USE_POSIX_2008_LOCALE
+
             if (locale_name_on_entry) {
                 setlocale(LC_NUMERIC, locale_name_on_entry);
             }
 
             LC_NUMERIC_UNLOCK;  /* End critical section */
 
+#  else
+
+            if (locale_name_on_entry) {
+                setlocale(LC_NUMERIC, locale_name_on_entry);
+                LC_NUMERIC_UNLOCK;
+            }
+            else if (locale_obj_on_entry == PL_underlying_numeric_obj) {
+                RESTORE_LC_NUMERIC();
+            }
+            else if (locale_obj_on_entry != PL_C_locale_obj) {
+                uselocale(locale_obj_on_entry);
+            }
+
+#  endif
+
         }
 
 #endif  /* USE_LOCALE_NUMERIC */
diff --git a/vutil.h b/vutil.h
index e291408db6..193c66d561 100644
--- a/vutil.h
+++ b/vutil.h
@@ -223,21 +223,28 @@ const char * Perl_prescan_version(pTHX_ const char *s, bool strict, const char**
 #endif
 
 
-#if PERL_VERSION_LT(5,19,0)
-# undef STORE_NUMERIC_LOCAL_SET_STANDARD
-# undef RESTORE_NUMERIC_LOCAL
-# ifdef USE_LOCALE
-#  define STORE_NUMERIC_LOCAL_SET_STANDARD()\
-	char *loc = savepv(setlocale(LC_NUMERIC, NULL)); \
+#if PERL_VERSION_LT(5,27,9)
+#  define LC_NUMERIC_LOCK
+#  define LC_NUMERIC_UNLOCK
+#    if PERL_VERSION_LT(5,19,0)
+#   undef STORE_LC_NUMERIC_SET_STANDARD
+#   undef RESTORE_LC_NUMERIC
+#   undef DECLARATION_FOR_LC_NUMERIC_MANIPULATION
+#   ifdef USE_LOCALE
+#    define DECLARATION_FOR_LC_NUMERIC_MANIPULATION char *loc
+#    define STORE_NUMERIC_SET_STANDARD()\
+	loc = savepv(setlocale(LC_NUMERIC, NULL));  \
 	SAVEFREEPV(loc); \
 	setlocale(LC_NUMERIC, "C");
 
-#  define RESTORE_NUMERIC_LOCAL()\
+#    define RESTORE_LC_NUMERIC()\
 	setlocale(LC_NUMERIC, loc);
-# else
-#  define STORE_NUMERIC_LOCAL_SET_STANDARD()
-#  define RESTORE_NUMERIC_LOCAL()
-# endif
+#   else
+#    define DECLARATION_FOR_LC_NUMERIC_MANIPULATION
+#    define STORE_LC_NUMERIC_SET_STANDARD()
+#    define RESTORE_LC_NUMERIC()
+#   endif
+#  endif
 #endif
 
 #ifndef LOCK_NUMERIC_STANDARD