Revert "Upgrade Digest::SHA from version 5.88 to 5.91"

[perl5.git] / locale.c

diff --git a/locale.c b/locale.c
index b89eb59..56cac85 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -348,6 +348,9 @@ Perl_my_setlocale(pTHX_ int category, const char* locale)
      * otherwise to use the particular category's variable if set; otherwise to
      * use the LANG variable. */
 
+    bool override_LC_ALL = 0;
+    char * result;
+
     if (locale && strEQ(locale, "")) {
 #   ifdef LC_ALL
         locale = PerlEnv_getenv("LC_ALL");
@@ -356,6 +359,7 @@ Perl_my_setlocale(pTHX_ int category, const char* locale)
             switch (category) {
 #   ifdef LC_ALL
                 case LC_ALL:
+                    override_LC_ALL = TRUE;
                     break;  /* We already know its variable isn't set */
 #   endif
 #   ifdef USE_LOCALE_TIME
@@ -404,7 +408,56 @@ Perl_my_setlocale(pTHX_ int category, const char* locale)
 #   endif
     }
 
-    return setlocale(category, locale);
+    result = setlocale(category, locale);
+
+    if (! override_LC_ALL)  {
+        return result;
+    }
+
+    /* Here the input locale was LC_ALL, and we have set it to what is in the
+     * LANG variable or the system default if there is no LANG.  But these have
+     * lower priority than the other LC_foo variables, so override it for each
+     * one that is set.  (If they are set to "", it means to use the same thing
+     * we just set LC_ALL to, so can skip) */
+#   ifdef USE_LOCALE_TIME
+    result = PerlEnv_getenv("LC_TIME");
+    if (result && strNE(result, "")) {
+        setlocale(LC_TIME, result);
+    }
+#   endif
+#   ifdef USE_LOCALE_CTYPE
+    result = PerlEnv_getenv("LC_CTYPE");
+    if (result && strNE(result, "")) {
+        setlocale(LC_CTYPE, result);
+    }
+#   endif
+#   ifdef USE_LOCALE_COLLATE
+    result = PerlEnv_getenv("LC_COLLATE");
+    if (result && strNE(result, "")) {
+        setlocale(LC_COLLATE, result);
+    }
+#   endif
+#   ifdef USE_LOCALE_MONETARY
+    result = PerlEnv_getenv("LC_MONETARY");
+    if (result && strNE(result, "")) {
+        setlocale(LC_MONETARY, result);
+    }
+#   endif
+#   ifdef USE_LOCALE_NUMERIC
+    result = PerlEnv_getenv("LC_NUMERIC");
+    if (result && strNE(result, "")) {
+        setlocale(LC_NUMERIC, result);
+    }
+#   endif
+#   ifdef USE_LOCALE_MESSAGES
+    result = PerlEnv_getenv("LC_MESSAGES");
+    if (result && strNE(result, "")) {
+        setlocale(LC_MESSAGES, result);
+    }
+#   endif
+
+    return setlocale(LC_ALL, NULL);
+
 }
 
 #endif
@@ -450,10 +503,8 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
     const char * const setlocale_init = (PerlEnv_getenv("PERL_SKIP_LOCALE_INIT"))
                                         ? NULL
                                         : "";
-    const char* trial_locales[5] = { setlocale_init }; /* 5 = 1 each for "",
-                                                          LC_ALL, LANG, "", C
-                                                        */
-    unsigned int trial_locales_count = 1;
+    const char* trial_locales[5];   /* 5 = 1 each for "", LC_ALL, LANG, "", C */
+    unsigned int trial_locales_count;
     char * const lc_all     = PerlEnv_getenv("LC_ALL");
     char * const lang       = PerlEnv_getenv("LANG");
     bool setlocale_failure = FALSE;
@@ -537,6 +588,8 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
 
     /* We try each locale in the list until we get one that works, or exhaust
      * the list */
+    trial_locales[0] = setlocale_init;
+    trial_locales_count = 1;
     for (i= 0; i < trial_locales_count; i++) {
         const char * trial_locale = trial_locales[i];
 
@@ -1024,6 +1077,7 @@ S_is_cur_LC_category_utf8(pTHX_ int category)
                 Safefree(save_input_locale);
                 return is_utf8;
             }
+            Safefree(codeset);
         }
 
 #   endif
@@ -1056,7 +1110,7 @@ S_is_cur_LC_category_utf8(pTHX_ int category)
             (void) mbtowc(&wc, NULL, 0);    /* Reset any shift state */
             GCC_DIAG_RESTORE;
             errno = 0;
-            if (mbtowc(&wc, HYPHEN_UTF8, strlen(HYPHEN_UTF8))
+            if ((size_t)mbtowc(&wc, HYPHEN_UTF8, strlen(HYPHEN_UTF8))
                                                         != strlen(HYPHEN_UTF8)
                 || wc != (wchar_t) 0x2010)
             {
@@ -1128,20 +1182,20 @@ S_is_cur_LC_category_utf8(pTHX_ int category)
         && *(save_input_locale + final_pos - 3) == '5'
         && *(save_input_locale + final_pos - 4) == '6')
     {
-        Safefree(save_input_locale);
         DEBUG_L(PerlIO_printf(Perl_debug_log,
                         "Locale %s ends with 10056 in name, is UTF-8 locale\n",
                         save_input_locale));
+        Safefree(save_input_locale);
         return TRUE;
     }
 #endif
 
     /* Other common encodings are the ISO 8859 series, which aren't UTF-8 */
     if (instr(save_input_locale, "8859")) {
-        Safefree(save_input_locale);
         DEBUG_L(PerlIO_printf(Perl_debug_log,
                              "Locale %s has 8859 in name, not UTF-8 locale\n",
                              save_input_locale));
+        Safefree(save_input_locale);
         return FALSE;
     }