This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use IsForeign throughout example
[perl5.git] / locale.c
index ff6322f..de171fc 100644 (file)
--- a/locale.c
+++ b/locale.c
 #ifdef I_WCHAR
 #  include <wchar.h>
 #endif
+#ifdef I_WCTYPE
+#  include <wctype.h>
+#endif
 
 /* If the environment says to, we can output debugging information during
  * initialization.  This is done before option parsing, and before any thread
  * creation, so can be a file-level static */
-#if ! defined(DEBUGGING) || defined(PERL_GLOBAL_STRUCT)
+#if ! defined(DEBUGGING)
 #  define debug_initialization 0
 #  define DEBUG_INITIALIZATION_set(v)
 #else
@@ -139,21 +142,21 @@ S_stdize_locale(pTHX_ char *locs)
     PERL_ARGS_ASSERT_STDIZE_LOCALE;
 
     if (s) {
-       const char * const t = strchr(s, '.');
-       okay = FALSE;
-       if (t) {
-           const char * const u = strchr(t, '\n');
-           if (u && (u[1] == 0)) {
-               const STRLEN len = u - s;
-               Move(s + 1, locs, len, char);
-               locs[len] = 0;
-               okay = TRUE;
-           }
-       }
+        const char * const t = strchr(s, '.');
+        okay = FALSE;
+        if (t) {
+            const char * const u = strchr(t, '\n');
+            if (u && (u[1] == 0)) {
+                const STRLEN len = u - s;
+                Move(s + 1, locs, len, char);
+                locs[len] = 0;
+                okay = TRUE;
+            }
+        }
     }
 
     if (!okay)
-       Perl_croak(aTHX_ "Can't fix broken locale name \"%s\"", locs);
+        Perl_croak(aTHX_ "Can't fix broken locale name \"%s\"", locs);
 
     return locs;
 }
@@ -197,6 +200,12 @@ const int categories[] = {
 #    ifdef USE_LOCALE_TELEPHONE
                              LC_TELEPHONE,
 #    endif
+#    ifdef USE_LOCALE_SYNTAX
+                             LC_SYNTAX,
+#    endif
+#    ifdef USE_LOCALE_TOD
+                             LC_TOD,
+#    endif
 #    ifdef LC_ALL
                              LC_ALL,
 #    endif
@@ -207,7 +216,7 @@ const int categories[] = {
 
 /* The top-most real element is LC_ALL */
 
-const char * category_names[] = {
+const char * const category_names[] = {
 
 #    ifdef USE_LOCALE_NUMERIC
                                  "LC_NUMERIC",
@@ -242,6 +251,12 @@ const char * category_names[] = {
 #    ifdef USE_LOCALE_TELEPHONE
                                  "LC_TELEPHONE",
 #    endif
+#    ifdef USE_LOCALE_SYNTAX
+                                 "LC_SYNTAX",
+#    endif
+#    ifdef USE_LOCALE_TOD
+                                 "LC_TOD",
+#    endif
 #    ifdef LC_ALL
                                  "LC_ALL",
 #    endif
@@ -331,7 +346,7 @@ S_category_name(const int category)
 #    define LC_COLLATE_INDEX            _DUMMY_CTYPE + 1
 #    define _DUMMY_COLLATE              LC_COLLATE_INDEX
 #  else
-#    define _DUMMY_COLLATE              _DUMMY_COLLATE
+#    define _DUMMY_COLLATE              _DUMMY_CTYPE
 #  endif
 #  ifdef USE_LOCALE_TIME
 #    define LC_TIME_INDEX               _DUMMY_COLLATE + 1
@@ -381,8 +396,20 @@ S_category_name(const int category)
 #  else
 #    define _DUMMY_TELEPHONE            _DUMMY_PAPER
 #  endif
+#  ifdef USE_LOCALE_SYNTAX
+#    define LC_SYNTAX_INDEX             _DUMMY_TELEPHONE + 1
+#    define _DUMMY_SYNTAX               LC_SYNTAX_INDEX
+#  else
+#    define _DUMMY_SYNTAX               _DUMMY_TELEPHONE
+#  endif
+#  ifdef USE_LOCALE_TOD
+#    define LC_TOD_INDEX                _DUMMY_SYNTAX + 1
+#    define _DUMMY_TOD                  LC_TOD_INDEX
+#  else
+#    define _DUMMY_TOD                  _DUMMY_SYNTAX
+#  endif
 #  ifdef LC_ALL
-#    define LC_ALL_INDEX                _DUMMY_TELEPHONE + 1
+#    define LC_ALL_INDEX                _DUMMY_TOD + 1
 #  endif
 #endif /* ifdef USE_LOCALE */
 
@@ -399,6 +426,7 @@ S_category_name(const int category)
  * 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)
+#  define FIX_GLIBC_LC_MESSAGES_BUG(i)
 
 #else   /* Below uses POSIX 2008 */
 
@@ -412,6 +440,22 @@ S_category_name(const int category)
                         emulate_setlocale(cat, locale, cat ## _INDEX, TRUE)
 #  define do_setlocale_r(cat, locale) emulate_setlocale(cat, locale, 0, FALSE)
 
+#  if ! defined(__GLIBC__) || ! defined(USE_LOCALE_MESSAGES)
+
+#    define FIX_GLIBC_LC_MESSAGES_BUG(i)
+
+#  else /* Invalidate glibc cache of loaded translations, see [perl #134264] */
+
+#    include <libintl.h>
+#    define FIX_GLIBC_LC_MESSAGES_BUG(i)                                        \
+        STMT_START {                                                        \
+            if ((i) == LC_MESSAGES_INDEX) {                                 \
+                textdomain(textdomain(NULL));                               \
+            }                                                               \
+        } STMT_END
+
+#  endif
+
 /* A third array, parallel to the ones above to map from category to its
  * equivalent mask */
 const int category_masks[] = {
@@ -448,6 +492,12 @@ const int category_masks[] = {
 #  ifdef USE_LOCALE_TELEPHONE
                                 LC_TELEPHONE_MASK,
 #  endif
+#  ifdef USE_LOCALE_SYNTAX
+                                LC_SYNTAX_MASK,
+#  endif
+#  ifdef USE_LOCALE_TOD
+                                LC_TOD_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.
@@ -586,12 +636,16 @@ S_emulate_setlocale(const int category,
         /* If this assert fails, adjust the size of curlocales in intrpvar.h */
         STATIC_ASSERT_STMT(C_ARRAY_LENGTH(PL_curlocales) > LC_ALL_INDEX);
 
-#    if defined(_NL_LOCALE_NAME) && defined(DEBUGGING)
-
+#    if   defined(_NL_LOCALE_NAME)                                          \
+     &&   defined(DEBUGGING)                                                \
+          /* On systems that accept any locale name, the real underlying    \
+           * locale is often returned by this internal function, so we      \
+           * can't use it */                                                \
+     && ! defined(SETLOCALE_ACCEPTS_ANY_LOCALE_NAME)
         {
             /* Internal glibc for querylocale(), but doesn't handle
              * empty-string ("") locale properly; who knows what other
-             * glitches.  Check it for now, under debug. */
+             * glitches.  Check for it now, under debug. */
 
             char * temp_name = nl_langinfo_l(_NL_LOCALE_NAME(category),
                                              uselocale((locale_t) 0));
@@ -733,7 +787,7 @@ S_emulate_setlocale(const int category,
 
 #  endif
 
-    }
+    }   /* End of this being setlocale(LC_foo, NULL) */
 
     /* Here, we are switching locales. */
 
@@ -763,24 +817,11 @@ S_emulate_setlocale(const int category,
 
             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"));
-            }
+            default_name = 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]);
@@ -815,22 +856,19 @@ S_emulate_setlocale(const int category,
 
                 for (i = 0; i < LC_ALL_INDEX; i++) {
                     const char * const env_override
-                                    = savepv(PerlEnv_getenv(category_names[i]));
+                                            = PerlEnv_getenv(category_names[i]);
                     const char * this_locale = (   env_override
                                                 && strNE(env_override, ""))
                                                ? env_override
                                                : default_name;
                     if (! emulate_setlocale(categories[i], this_locale, i, TRUE))
                     {
-                        Safefree(env_override);
                         return NULL;
                     }
 
                     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
@@ -852,7 +890,7 @@ S_emulate_setlocale(const int category,
                 }
             }
         }
-    }
+    }   /* End of this being setlocale(LC_foo, "") */
     else if (strchr(locale, ';')) {
 
         /* LC_ALL may actually incude a conglomeration of various categories.
@@ -949,7 +987,8 @@ S_emulate_setlocale(const int category,
         assert(category == LC_ALL);
 
         return do_setlocale_c(LC_ALL, NULL);
-    }
+    }   /* End of this being setlocale(LC_ALL,
+           "LC_CTYPE=foo;LC_NUMERIC=bar;...") */
 
   ready_to_set: ;
 
@@ -996,89 +1035,133 @@ S_emulate_setlocale(const int category,
 #  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);
+        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;
-    }
-
-    /* Ready to create a new locale by modification of the exising one */
-    new_obj = newlocale(mask, locale, old_obj);
-
-    if (! new_obj) {
-        dSAVE_ERRNO;
+    /* If this call is to switch to the LC_ALL C locale, it already exists, and
+     * in fact, we already have switched to it (in preparation for what
+     * normally is to come).  But since we're already there, continue to use
+     * it instead of trying to create a new locale */
+    if (mask == LC_ALL_MASK && isNAME_C_OR_POSIX(locale)) {
 
 #  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);
+        if (DEBUG_Lv_TEST || debug_initialization) {
+            PerlIO_printf(Perl_debug_log,
+                          "%s:%d: will stay in C object\n", __FILE__, __LINE__);
         }
 
 #  endif
 
-        if (! uselocale(old_obj)) {
+        new_obj = PL_C_locale_obj;
+
+        /* We already had switched to the C locale in preparation for freeing
+         * 'old_obj' */
+        if (old_obj != LC_GLOBAL_LOCALE && old_obj != PL_C_locale_obj) {
+            freelocale(old_obj);
+        }
+    }
+    else {
+        /* 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;
+        }
+
+        /* 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: switching back failed: %d\n", __FILE__, __LINE__, GET_ERRNO);
+                PerlIO_printf(Perl_debug_log,
+                              "%s:%d: emulate_setlocale creating new object"
+                              " failed: %d\n", __FILE__, __LINE__, GET_ERRNO);
             }
 
 #  endif
 
-        }
-        RESTORE_ERRNO;
-        return NULL;
-    }
+            if (! uselocale(old_obj)) {
 
 #  ifdef DEBUGGING
 
-    if (DEBUG_Lv_TEST || debug_initialization) {
-        PerlIO_printf(Perl_debug_log, "%s:%d: emulate_setlocale created %p; should have freed %p\n", __FILE__, __LINE__, new_obj, old_obj);
-    }
+                if (DEBUG_L_TEST || debug_initialization) {
+                    PerlIO_printf(Perl_debug_log,
+                                  "%s:%d: switching back failed: %d\n",
+                                  __FILE__, __LINE__, GET_ERRNO);
+                }
 
 #  endif
 
-    /* And switch into it */
-    if (! uselocale(new_obj)) {
-        dSAVE_ERRNO;
+            }
+            RESTORE_ERRNO;
+            return NULL;
+        }
 
 #  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__);
+        if (DEBUG_Lv_TEST || debug_initialization) {
+            PerlIO_printf(Perl_debug_log,
+                          "%s:%d: emulate_setlocale created %p",
+                          __FILE__, __LINE__, new_obj);
+            if (old_obj) {
+                PerlIO_printf(Perl_debug_log,
+                              "; should have freed %p", old_obj);
+            }
+            PerlIO_printf(Perl_debug_log, "\n");
         }
 
 #  endif
 
-        if (! uselocale(old_obj)) {
+        /* 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: switching back failed: %d\n", __FILE__, __LINE__, GET_ERRNO);
+                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;
         }
-        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);
+        PerlIO_printf(Perl_debug_log,
+                      "%s:%d: emulate_setlocale now using %p\n",
+                      __FILE__, __LINE__, new_obj);
     }
 
 #  endif
@@ -1110,6 +1193,8 @@ S_emulate_setlocale(const int category,
             Safefree(PL_curlocales[i]);
             PL_curlocales[i] = savepv(locale);
         }
+
+        FIX_GLIBC_LC_MESSAGES_BUG(LC_MESSAGES_INDEX);
     }
     else {
 
@@ -1124,6 +1209,8 @@ S_emulate_setlocale(const int category,
         /* Then update the category's record */
         Safefree(PL_curlocales[index]);
         PL_curlocales[index] = savepv(locale);
+
+        FIX_GLIBC_LC_MESSAGES_BUG(index);
     }
 
 #  endif
@@ -1133,137 +1220,6 @@ S_emulate_setlocale(const int category,
 
 #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
 #ifdef USE_LOCALE
 
 STATIC void
@@ -1353,12 +1309,12 @@ S_new_numeric(pTHX_ const char *newnum)
     char *save_newnum;
 
     if (! newnum) {
-       Safefree(PL_numeric_name);
-       PL_numeric_name = NULL;
-       PL_numeric_standard = TRUE;
-       PL_numeric_underlying = TRUE;
-       PL_numeric_underlying_is_standard = TRUE;
-       return;
+        Safefree(PL_numeric_name);
+        PL_numeric_name = NULL;
+        PL_numeric_standard = TRUE;
+        PL_numeric_underlying = TRUE;
+        PL_numeric_underlying_is_standard = TRUE;
+        return;
     }
 
     save_newnum = stdize_locale(savepv(newnum));
@@ -1381,11 +1337,11 @@ S_new_numeric(pTHX_ const char *newnum)
 
     /* 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);
-       PL_numeric_name = save_newnum;
+        Safefree(PL_numeric_name);
+        PL_numeric_name = save_newnum;
     }
     else {
-       Safefree(save_newnum);
+        Safefree(save_newnum);
     }
 
     PL_numeric_underlying_is_standard = PL_numeric_standard;
@@ -1502,11 +1458,11 @@ S_new_ctype(pTHX_ const char *newctype)
      * this function should be called directly only from this file and from
      * POSIX::setlocale() */
 
-    dVAR;
     unsigned int i;
 
     /* Don't check for problems if we are suppressing the warnings */
     bool check_for_problems = ckWARN_d(WARN_LOCALE) || UNLIKELY(DEBUG_L_TEST);
+    bool maybe_utf8_turkic = FALSE;
 
     PERL_ARGS_ASSERT_NEW_CTYPE;
 
@@ -1523,6 +1479,23 @@ S_new_ctype(pTHX_ const char *newctype)
      * handle this specially because of the three problematic code points */
     if (PL_in_utf8_CTYPE_locale) {
         Copy(PL_fold_latin1, PL_fold_locale, 256, U8);
+
+        /* UTF-8 locales can have special handling for 'I' and 'i' if they are
+         * Turkic.  Make sure these two are the only anomalies.  (We don't use
+         * towupper and towlower because they aren't in C89.) */
+
+#if defined(HAS_TOWUPPER) && defined (HAS_TOWLOWER)
+
+        if (towupper('i') == 0x130 && towlower('I') == 0x131) {
+
+#else
+
+        if (toupper('i') == 'i' && tolower('I') == 'I') {
+
+#endif
+            check_for_problems = TRUE;
+            maybe_utf8_turkic = TRUE;
+        }
     }
 
     /* We don't populate the other lists if a UTF-8 locale, but do check that
@@ -1639,13 +1612,13 @@ S_new_ctype(pTHX_ const char *newctype)
                                           "isxdigit('%s') unexpectedly is %d\n",
                                           name, cBOOL(isxdigit(i))));
                 }
-                if (UNLIKELY(tolower(i) != (int) toLOWER_A(i)))  {
+                if (UNLIKELY(tolower(i) != (int) toLOWER_A(i))) {
                     is_bad = TRUE;
                     DEBUG_L(PerlIO_printf(Perl_debug_log,
                             "tolower('%s')=0x%x instead of the expected 0x%x\n",
                             name, tolower(i), (int) toLOWER_A(i)));
                 }
-                if (UNLIKELY(toupper(i) != (int) toUPPER_A(i)))  {
+                if (UNLIKELY(toupper(i) != (int) toUPPER_A(i))) {
                     is_bad = TRUE;
                     DEBUG_L(PerlIO_printf(Perl_debug_log,
                             "toupper('%s')=0x%x instead of the expected 0x%x\n",
@@ -1668,6 +1641,19 @@ S_new_ctype(pTHX_ const char *newctype)
             }
         }
 
+        if (bad_count == 2 && maybe_utf8_turkic) {
+            bad_count = 0;
+            *bad_chars_list = '\0';
+            PL_fold_locale['I'] = 'I';
+            PL_fold_locale['i'] = 'i';
+            PL_in_utf8_turkic_locale = TRUE;
+            DEBUG_L(PerlIO_printf(Perl_debug_log, "%s:%d: %s is turkic\n",
+                                                 __FILE__, __LINE__, newctype));
+        }
+        else {
+            PL_in_utf8_turkic_locale = FALSE;
+        }
+
 #  ifdef MB_CUR_MAX
 
         /* We only handle single-byte locales (outside of UTF-8 ones; so if
@@ -1693,7 +1679,10 @@ S_new_ctype(pTHX_ const char *newctype)
 
 #  endif
 
-        if (UNLIKELY(bad_count) || UNLIKELY(multi_byte_locale)) {
+        /* If we found problems and we want them output, do so */
+        if (   (UNLIKELY(bad_count) || UNLIKELY(multi_byte_locale))
+            && (LIKELY(ckWARN_d(WARN_LOCALE)) || UNLIKELY(DEBUG_L_TEST)))
+        {
             if (UNLIKELY(bad_count) && PL_in_utf8_CTYPE_locale) {
                 PL_warn_locale = Perl_newSVpvf(aTHX_
                      "Locale '%s' contains (at least) the following characters"
@@ -1805,27 +1794,27 @@ S_new_collate(pTHX_ const char *newcoll)
      * an unlikely bug */
 
     if (! newcoll) {
-       if (PL_collation_name) {
-           ++PL_collation_ix;
-           Safefree(PL_collation_name);
-           PL_collation_name = NULL;
-       }
-       PL_collation_standard = TRUE;
+        if (PL_collation_name) {
+            ++PL_collation_ix;
+            Safefree(PL_collation_name);
+            PL_collation_name = NULL;
+        }
+        PL_collation_standard = TRUE;
       is_standard_collation:
-       PL_collxfrm_base = 0;
-       PL_collxfrm_mult = 2;
+        PL_collxfrm_base = 0;
+        PL_collxfrm_mult = 2;
         PL_in_utf8_COLLATE_locale = FALSE;
         PL_strxfrm_NUL_replacement = '\0';
         PL_strxfrm_max_cp = 0;
-       return;
+        return;
     }
 
     /* If this is not the same locale as currently, set the new one up */
     if (! PL_collation_name || strNE(PL_collation_name, newcoll)) {
-       ++PL_collation_ix;
-       Safefree(PL_collation_name);
-       PL_collation_name = stdize_locale(savepv(newcoll));
-       PL_collation_standard = isNAME_C_OR_POSIX(newcoll);
+        ++PL_collation_ix;
+        Safefree(PL_collation_name);
+        PL_collation_name = stdize_locale(savepv(newcoll));
+        PL_collation_standard = isNAME_C_OR_POSIX(newcoll);
         if (PL_collation_standard) {
             goto is_standard_collation;
         }
@@ -1875,7 +1864,7 @@ S_new_collate(pTHX_ const char *newcoll)
          * get it right the first time to avoid wasted expensive string
          * transformations. */
 
-       {
+        {
             /* We use the string below to find how long the tranformation of it
              * is.  Almost all locales are supersets of ASCII, or at least the
              * ASCII letters.  We use all of them, half upper half lower,
@@ -1991,7 +1980,7 @@ S_new_collate(pTHX_ const char *newcoll)
             }
 #  endif
 
-       }
+        }
     }
 
 #endif /* USE_LOCALE_COLLATE */
@@ -2002,6 +1991,57 @@ S_new_collate(pTHX_ const char *newcoll)
 
 #ifdef WIN32
 
+#define USE_WSETLOCALE
+
+#ifdef USE_WSETLOCALE
+
+STATIC char *
+S_wrap_wsetlocale(pTHX_ int category, const char *locale) {
+    wchar_t *wlocale;
+    wchar_t *wresult;
+    char *result;
+
+    if (locale) {
+        int req_size =
+            MultiByteToWideChar(CP_UTF8, 0, locale, -1, NULL, 0);
+
+        if (!req_size) {
+            errno = EINVAL;
+            return NULL;
+        }
+
+        Newx(wlocale, req_size, wchar_t);
+        if (!MultiByteToWideChar(CP_UTF8, 0, locale, -1, wlocale, req_size)) {
+            Safefree(wlocale);
+            errno = EINVAL;
+            return NULL;
+        }
+    }
+    else {
+        wlocale = NULL;
+    }
+    wresult = _wsetlocale(category, wlocale);
+    Safefree(wlocale);
+    if (wresult) {
+        int req_size =
+            WideCharToMultiByte(CP_UTF8, 0, wresult, -1, NULL, 0, NULL, NULL);
+        Newx(result, req_size, char);
+        SAVEFREEPV(result); /* is there something better we can do here? */
+        if (!WideCharToMultiByte(CP_UTF8, 0, wresult, -1,
+                                 result, req_size, NULL, NULL)) {
+            errno = EINVAL;
+            return NULL;
+        }
+    }
+    else {
+        result = NULL;
+    }
+
+    return result;
+}
+
+#endif
+
 STATIC char *
 S_win32_setlocale(pTHX_ int category, const char* locale)
 {
@@ -2059,7 +2099,11 @@ S_win32_setlocale(pTHX_ int category, const char* locale)
 
     }
 
+#ifdef USE_WSETLOCALE
+    result = S_wrap_wsetlocale(aTHX_ category, locale);
+#else
     result = setlocale(category, locale);
+#endif
     DEBUG_L(STMT_START {
                 dSAVE_ERRNO;
                 PerlIO_printf(Perl_debug_log, "%s:%d: %s\n", __FILE__, __LINE__,
@@ -2080,7 +2124,11 @@ S_win32_setlocale(pTHX_ int category, const char* locale)
     for (i = 0; i < LC_ALL_INDEX; i++) {
         result = PerlEnv_getenv(category_names[i]);
         if (result && strNE(result, "")) {
+#ifdef USE_WSETLOCALE
+            S_wrap_wsetlocale(aTHX_ categories[i], result);
+#else
             setlocale(categories[i], result);
+#endif
             DEBUG_Lv(PerlIO_printf(Perl_debug_log, "%s:%d: %s\n",
                 __FILE__, __LINE__,
                 setlocale_debug_string(categories[i], result, "not captured")));
@@ -2102,9 +2150,6 @@ S_win32_setlocale(pTHX_ int category, const char* locale)
 #endif
 
 /*
-
-=head1 Locale-related functions and macros
-
 =for apidoc Perl_setlocale
 
 This is an (almost) drop-in replacement for the system L<C<setlocale(3)>>,
@@ -2145,7 +2190,7 @@ Perl_setlocale(const int category, const char * locale)
 {
     /* This wraps POSIX::setlocale() */
 
-#ifdef NO_LOCALE
+#ifndef USE_LOCALE
 
     PERL_UNUSED_ARG(category);
     PERL_UNUSED_ARG(locale);
@@ -2350,7 +2395,7 @@ the other advantages of C<Perl_langinfo()>; not keeping C<LC_NUMERIC> in the C
 =item *
 
 The system function it replaces can have its static return buffer trashed,
-not only by a subesequent call to that function, but by a C<freelocale>,
+not only by a subsequent call to that function, but by a C<freelocale>,
 C<setlocale>, or other locale change.  The returned buffer of this function is
 not changed until the next call to it, so the buffer is never in a trashed
 state.
@@ -2444,8 +2489,7 @@ S_my_nl_langinfo(const int item, bool toggle)
 
 #if defined(HAS_NL_LANGINFO) /* nl_langinfo() is available.  */
 #  if   ! defined(HAS_THREAD_SAFE_NL_LANGINFO_L)      \
-     || ! defined(HAS_POSIX_2008_LOCALE)              \
-     || ! defined(DUPLOCALE)
+     || ! defined(HAS_POSIX_2008_LOCALE)
 
     /* Here, use plain nl_langinfo(), switching to the underlying LC_NUMERIC
      * for those items dependent on it.  This must be copied to a buffer before
@@ -2459,18 +2503,16 @@ S_my_nl_langinfo(const int item, bool toggle)
             STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
         }
 
-        LOCALE_LOCK;    /* Prevent interference from another thread executing
-                           this code section (the only call to nl_langinfo in
-                           the core) */
-
+        /* Prevent interference from another thread executing this code
+         * section. */
+        NL_LANGINFO_LOCK;
 
         /* Copy to a per-thread buffer, which is also one that won't be
          * destroyed by a subsequent setlocale(), such as the
          * RESTORE_LC_NUMERIC may do just below. */
         retval = save_to_buffer(nl_langinfo(item),
                                 &PL_langinfo_buf, &PL_langinfo_bufsize, 0);
-
-        LOCALE_UNLOCK;
+        NL_LANGINFO_UNLOCK;
 
         if (toggle) {
             RESTORE_LC_NUMERIC();
@@ -2644,8 +2686,8 @@ S_my_nl_langinfo(const int item, bool toggle)
                 /* We don't bother with localeconv_l() because any system that
                  * has it is likely to also have nl_langinfo() */
 
-                LOCALE_LOCK_V;    /* Prevent interference with other threads
-                                     using localeconv() */
+                LOCALECONV_LOCK;    /* Prevent interference with other threads
+                                       using localeconv() */
 
 #    ifdef TS_W32_BROKEN_LOCALECONV
 
@@ -2672,7 +2714,7 @@ S_my_nl_langinfo(const int item, bool toggle)
                     || ! lc->currency_symbol
                     || strEQ("", lc->currency_symbol))
                 {
-                    LOCALE_UNLOCK_V;
+                    LOCALECONV_UNLOCK;
                     return "";
                 }
 
@@ -2702,7 +2744,7 @@ S_my_nl_langinfo(const int item, bool toggle)
 
 #    endif
 
-                LOCALE_UNLOCK_V;
+                LOCALECONV_UNLOCK;
                 break;
 
 #    ifdef TS_W32_BROKEN_LOCALECONV
@@ -2775,8 +2817,8 @@ S_my_nl_langinfo(const int item, bool toggle)
                     STORE_LC_NUMERIC_FORCE_TO_UNDERLYING();
                 }
 
-                LOCALE_LOCK_V;    /* Prevent interference with other threads
-                                     using localeconv() */
+                LOCALECONV_LOCK;    /* Prevent interference with other threads
+                                       using localeconv() */
 
 #    ifdef TS_W32_BROKEN_LOCALECONV
 
@@ -2828,7 +2870,7 @@ S_my_nl_langinfo(const int item, bool toggle)
 
 #    endif
 
-                LOCALE_UNLOCK_V;
+                LOCALECONV_UNLOCK;
 
                 if (toggle) {
                     RESTORE_LC_NUMERIC();
@@ -2866,8 +2908,6 @@ S_my_nl_langinfo(const int item, bool toggle)
             case MON_5: case MON_6: case MON_7: case MON_8:
             case MON_9: case MON_10: case MON_11: case MON_12:
 
-                LOCALE_LOCK;
-
                 init_tm(&tm);   /* Precaution against core dumps */
                 tm.tm_sec = 30;
                 tm.tm_min = 30;
@@ -2875,9 +2915,11 @@ S_my_nl_langinfo(const int item, bool toggle)
                 tm.tm_year = 2017 - 1900;
                 tm.tm_wday = 0;
                 tm.tm_mon = 0;
+
+                GCC_DIAG_IGNORE_STMT(-Wimplicit-fallthrough);
+
                 switch (item) {
                     default:
-                        LOCALE_UNLOCK;
                         Perl_croak(aTHX_
                                     "panic: %s: %d: switch case: %d problem",
                                        __FILE__, __LINE__, item);
@@ -2964,6 +3006,8 @@ S_my_nl_langinfo(const int item, bool toggle)
                         break;
                 }
 
+                GCC_DIAG_RESTORE_STMT;
+
                 /* We can't use my_strftime() because it doesn't look at
                  * tm_wday  */
                 while (0 == strftime(PL_langinfo_buf, PL_langinfo_bufsize,
@@ -3053,8 +3097,6 @@ S_my_nl_langinfo(const int item, bool toggle)
                  * wday was chosen because its range is all a single digit.
                  * Things like tm_sec have two digits as the minimum: '00' */
 
-                LOCALE_UNLOCK;
-
                 retval = PL_langinfo_buf;
 
                 /* If to return the format, not the value, overwrite the buffer
@@ -3137,6 +3179,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
      * values for our db, instead of trying to change them.
      * */
 
+
     int ok = 1;
 
 #ifndef USE_LOCALE
@@ -3146,7 +3189,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 #else  /* USE_LOCALE */
 #  ifdef __GLIBC__
 
-    const char * const language   = savepv(PerlEnv_getenv("LANGUAGE"));
+    const char * const language = PerlEnv_getenv("LANGUAGE");
 
 #  endif
 
@@ -3156,8 +3199,8 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
                                         : "";
     const char* trial_locales[5];   /* 5 = 1 each for "", LC_ALL, LANG, "", C */
     unsigned int trial_locales_count;
-    const char * const lc_all     = savepv(PerlEnv_getenv("LC_ALL"));
-    const char * const lang       = savepv(PerlEnv_getenv("LANG"));
+    const char * const lc_all     = PerlEnv_getenv("LC_ALL");
+    const char * const lang       = PerlEnv_getenv("LANG");
     bool setlocale_failure = FALSE;
     unsigned int i;
 
@@ -3198,8 +3241,8 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
     DEBUG_INITIALIZATION_set(cBOOL(PerlEnv_getenv("PERL_DEBUG_LOCALE_INIT")));
 
 #    define DEBUG_LOCALE_INIT(category, locale, result)                     \
-       STMT_START {                                                        \
-               if (debug_initialization) {                                 \
+        STMT_START {                                                        \
+                if (debug_initialization) {                                 \
                     PerlIO_printf(Perl_debug_log,                           \
                                   "%s:%d: %s\n",                            \
                                   __FILE__, __LINE__,                       \
@@ -3207,7 +3250,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
                                                           locale,           \
                                                           result));         \
                 }                                                           \
-       } STMT_END
+        } STMT_END
 
 /* Make sure the parallel arrays are properly set up */
 #    ifdef USE_LOCALE_NUMERIC
@@ -3287,6 +3330,20 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
     assert(category_masks[LC_TELEPHONE_INDEX] == LC_TELEPHONE_MASK);
 #      endif
 #    endif
+#    ifdef USE_LOCALE_SYNTAX
+    assert(categories[LC_SYNTAX_INDEX] == LC_SYNTAX);
+    assert(strEQ(category_names[LC_SYNTAX_INDEX], "LC_SYNTAX"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_SYNTAX_INDEX] == LC_SYNTAX_MASK);
+#      endif
+#    endif
+#    ifdef USE_LOCALE_TOD
+    assert(categories[LC_TOD_INDEX] == LC_TOD);
+    assert(strEQ(category_names[LC_TOD_INDEX], "LC_TOD"));
+#      ifdef USE_POSIX_2008_LOCALE
+    assert(category_masks[LC_TOD_INDEX] == LC_TOD_MASK);
+#      endif
+#    endif
 #    ifdef LC_ALL
     assert(categories[LC_ALL_INDEX] == LC_ALL);
     assert(strEQ(category_names[LC_ALL_INDEX], "LC_ALL"));
@@ -3297,6 +3354,18 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 #    endif
 #  endif    /* DEBUGGING */
 
+    /* Initialize the per-thread mbrFOO() state variables.  See POSIX.xs for
+     * why these particular incantations are used. */
+#ifdef HAS_MBRLEN
+    memzero(&PL_mbrlen_ps, sizeof(PL_mbrlen_ps));
+#endif
+#ifdef HAS_MBRTOWC
+    memzero(&PL_mbrtowc_ps, sizeof(PL_mbrtowc_ps));
+#endif
+#ifdef HAS_WCTOMBR
+    wcrtomb(NULL, L'\0', &PL_wcrtomb_ps);
+#endif
+
     /* Initialize the cache of the program's UTF-8ness for the always known
      * locales C and POSIX */
     my_strlcpy(PL_locale_utf8ness, C_and_POSIX_utf8ness,
@@ -3322,8 +3391,12 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 
 #  endif
 
+#  ifdef USE_LOCALE_NUMERIC
+
     PL_numeric_radix_sv = newSVpvs(".");
 
+#  endif
+
 #  if defined(USE_POSIX_2008_LOCALE) && ! defined(HAS_QUERYLOCALE)
 
     /* Initialize our records.  If we have POSIX 2008, we have LC_ALL */
@@ -3722,22 +3795,13 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
        This is an alternative to using the -C command line switch
        (the -C if present will override this). */
     {
-        const char *p = PerlEnv_getenv("PERL_UNICODE");
-        PL_unicode = p ? parse_unicode_opts(&p) : 0;
-        if (PL_unicode & PERL_UNICODE_UTF8CACHEASSERT_FLAG)
-            PL_utf8cache = -1;
+         const char *p = PerlEnv_getenv("PERL_UNICODE");
+         PL_unicode = p ? parse_unicode_opts(&p) : 0;
+         if (PL_unicode & PERL_UNICODE_UTF8CACHEASSERT_FLAG)
+             PL_utf8cache = -1;
     }
 
 #  endif
-#  ifdef __GLIBC__
-
-    Safefree(language);
-
-#  endif
-
-    Safefree(lc_all);
-    Safefree(lang);
-
 #endif /* USE_LOCALE */
 #ifdef DEBUGGING
 
@@ -3863,6 +3927,7 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
                                  cur_min_x + COLLXFRM_HDR_LEN))
                     {
                         PL_strxfrm_NUL_replacement = j;
+                        Safefree(cur_min_x);
                         cur_min_x = x;
                     }
                     else {
@@ -4018,6 +4083,7 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
                                      cur_max_x + COLLXFRM_HDR_LEN))
                         {
                             PL_strxfrm_max_cp = j;
+                            Safefree(cur_max_x);
                             cur_max_x = x;
                         }
                         else {
@@ -4095,7 +4161,7 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
     if (UNLIKELY(! xbuf)) {
         DEBUG_L(PerlIO_printf(Perl_debug_log,
                       "_mem_collxfrm: Couldn't malloc %zu bytes\n", xAlloc));
-       goto bad;
+        goto bad;
     }
 
     /* Store the collation id */
@@ -4259,11 +4325,6 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
     return xbuf;
 
   bad:
-    Safefree(xbuf);
-    if (s != input_string) {
-        Safefree(s);
-    }
-    *xlen = 0;
 
 #  ifdef DEBUGGING
 
@@ -4273,6 +4334,12 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
 
 #  endif
 
+    Safefree(xbuf);
+    if (s != input_string) {
+        Safefree(s);
+    }
+    *xlen = 0;
+
     return NULL;
 }
 
@@ -4303,6 +4370,11 @@ S_print_collxfrm_input_and_return(pTHX_
     PerlIO_printf(Perl_debug_log, "'\n");
 }
 
+#  endif    /* DEBUGGING */
+#endif /* USE_LOCALE_COLLATE */
+#ifdef USE_LOCALE
+#  ifdef DEBUGGING
+
 STATIC void
 S_print_bytes_for_locale(pTHX_
                     const char * const s,
@@ -4339,9 +4411,6 @@ S_print_bytes_for_locale(pTHX_
 }
 
 #  endif   /* #ifdef DEBUGGING */
-#endif /* USE_LOCALE_COLLATE */
-
-#ifdef USE_LOCALE
 
 STATIC const char *
 S_switch_category_locale_to_template(pTHX_ const int switch_category, const int template_category, const char * template_locale)
@@ -4385,7 +4454,7 @@ S_switch_category_locale_to_template(pTHX_ const int switch_category, const int
         Safefree(restore_to_locale);
 
         DEBUG_Lv(PerlIO_printf(Perl_debug_log, "%s locale unchanged as %s\n",
-                            category_name(switch_category), restore_to_locale));
+                            category_name(switch_category), template_locale));
 
         return NULL;
     }
@@ -4642,12 +4711,12 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category)
 
 #      else
 
-            LOCALE_LOCK;
+            MBTOWC_LOCK;
             PERL_UNUSED_RESULT(mbtowc(&wc, NULL, 0));/* Reset any shift state */
             SETERRNO(0, 0);
             len = mbtowc(&wc, STR_WITH_LEN(REPLACEMENT_CHARACTER_UTF8));
             SAVE_ERRNO;
-            LOCALE_UNLOCK;
+            MBTOWC_UNLOCK;
 
 #      endif
 
@@ -4963,9 +5032,7 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category)
         Copy(delimited, utf8ness_cache, input_name_len_with_overhead - 1, char);
         utf8ness_cache[input_name_len_with_overhead - 1] = is_utf8 + '0';
 
-        if ((PL_locale_utf8ness[strlen(PL_locale_utf8ness)-1]
-                                                & (PERL_UINTMAX_T) ~1) != '0')
-        {
+        if ((PL_locale_utf8ness[strlen(PL_locale_utf8ness)-1] & ~1) != '0') {
             Perl_croak(aTHX_
              "panic: %s: %d: Corrupt utf8ness_cache=%s\nlen=%zu,"
              " inserted_name=%s, its_len=%zu\n",
@@ -4995,6 +5062,7 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category)
             s++;
             e = strchr(s, UTF8NESS_PREFIX[0]);
             if (! e) {
+                e = PL_locale_utf8ness + strlen(PL_locale_utf8ness);
                 Perl_croak(aTHX_
                            "panic: %s: %d: Corrupt utf8ness_cache: missing"
                            " separator %.*s<-- HERE %s\n",
@@ -5043,22 +5111,21 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category)
 bool
 Perl__is_in_locale_category(pTHX_ const bool compiling, const int category)
 {
-    dVAR;
     /* Internal function which returns if we are in the scope of a pragma that
      * enables the locale category 'category'.  'compiling' should indicate if
      * this is during the compilation phase (TRUE) or not (FALSE). */
 
     const COP * const cop = (compiling) ? &PL_compiling : PL_curcop;
 
-    SV *categories = cop_hints_fetch_pvs(cop, "locale", 0);
-    if (! categories || categories == &PL_sv_placeholder) {
+    SV *these_categories = cop_hints_fetch_pvs(cop, "locale", 0);
+    if (! these_categories || these_categories == &PL_sv_placeholder) {
         return FALSE;
     }
 
     /* The pseudo-category 'not_characters' is -1, so just add 1 to each to get
      * a valid unsigned */
     assert(category >= -1);
-    return cBOOL(SvUV(categories) & (1U << (category + 1)));
+    return cBOOL(SvUV(these_categories) & (1U << (category + 1)));
 }
 
 char *
@@ -5074,7 +5141,6 @@ Perl_my_strerror(pTHX_ const int errnum)
      * to the C locale */
 
     char *errstr;
-    dVAR;
 
 #ifndef USE_LOCALE_MESSAGES
 
@@ -5102,9 +5168,8 @@ Perl_my_strerror(pTHX_ const int errnum)
         Safefree(save_locale);
     }
 
-#  elif defined(HAS_POSIX_2008_LOCALE)                      \
-     && defined(HAS_STRERROR_L)                             \
-     && defined(HAS_DUPLOCALE)
+#  elif   defined(USE_POSIX_2008_LOCALE)                      \
+     &&   defined(HAS_STRERROR_L)
 
     /* This function is also trivial if we don't have to worry about thread
      * safety and have strerror_l(), as it handles the switch of locales so we
@@ -5159,13 +5224,14 @@ Perl_my_strerror(pTHX_ const int errnum)
      * 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;
+    SETLOCALE_LOCK;
 
     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
                             "my_strerror called with errnum %d\n", errnum));
     if (! within_locale_scope) {
         save_locale = do_setlocale_c(LC_MESSAGES, NULL);
         if (! save_locale) {
+            SETLOCALE_UNLOCK;
             Perl_croak(aTHX_
                  "panic: %s: %d: Could not find current LC_MESSAGES locale,"
                  " errno=%d\n", __FILE__, __LINE__, errno);
@@ -5179,7 +5245,19 @@ Perl_my_strerror(pTHX_ const int errnum)
                 /* The setlocale() just below likely will zap 'save_locale', so
                  * create a copy.  */
                 save_locale = savepv(save_locale);
-                do_setlocale_c(LC_MESSAGES, "C");
+                if (! do_setlocale_c(LC_MESSAGES, "C")) {
+
+                    /* If, for some reason, the locale change failed, we
+                     * soldier on as best as possible under the circumstances,
+                     * using the current locale, and clear save_locale, so we
+                     * don't try to change back.  On z/0S, all setlocale()
+                     * calls fail after you've created a thread.  This is their
+                     * way of making sure the entire process is always a single
+                     * locale.  This means that 'use locale' is always in place
+                     * for messages under these circumstances. */
+                    Safefree(save_locale);
+                    save_locale = NULL;
+                }
             }
         }
     }   /* end of ! within_locale_scope */
@@ -5195,15 +5273,16 @@ Perl_my_strerror(pTHX_ const int errnum)
     if (! within_locale_scope) {
         if (save_locale && ! locale_is_C) {
             if (! do_setlocale_c(LC_MESSAGES, save_locale)) {
+                SETLOCALE_UNLOCK;
                 Perl_croak(aTHX_
-                     "panic: %s: %d: setlocale restore failed, errno=%d\n",
-                             __FILE__, __LINE__, errno);
+                     "panic: %s: %d: setlocale restore to '%s' failed, errno=%d\n",
+                             __FILE__, __LINE__, save_locale, errno);
             }
             Safefree(save_locale);
         }
     }
 
-    LOCALE_UNLOCK;
+    SETLOCALE_UNLOCK;
 
 #  endif /* End of doesn't have strerror_l */
 #  ifdef DEBUGGING
@@ -5225,7 +5304,7 @@ Perl_my_strerror(pTHX_ const int errnum)
 
 =for apidoc switch_to_global_locale
 
-On systems without locale support, or on single-threaded builds, or on
+On systems without locale support, or on typical single-threaded builds, or on
 platforms that do not support per-thread locale operations, this function does
 nothing.  On such systems that do have locale support, only a locale global to
 the whole program is available.
@@ -5436,11 +5515,7 @@ S_setlocale_debug_string(const int category,        /* category number,
      * be overwritten by the next call, so this should be used just to
      * formulate a string to immediately print or savepv() on. */
 
-    /* initialise to a non-null value to keep it out of BSS and so keep
-     * -DPERL_GLOBAL_STRUCT_PRIVATE happy */
-    static char ret[256] = "If you can read this, thank your buggy C"
-                           " library strlcpy(), and change your hints file"
-                           " to undef it";
+    static char ret[256];
 
     my_strlcpy(ret, "setlocale(", sizeof(ret));
     my_strlcat(ret, category_name(category), sizeof(ret));
@@ -5516,7 +5591,7 @@ Perl_thread_locale_term()
 
     {   /* Free up */
         locale_t cur_obj = uselocale(LC_GLOBAL_LOCALE);
-        if (cur_obj != LC_GLOBAL_LOCALE) {
+        if (cur_obj != LC_GLOBAL_LOCALE && cur_obj != PL_C_locale_obj) {
             freelocale(cur_obj);
         }
     }