This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldelta: Add some C<>
[perl5.git] / locale.c
index 0a2669f..bf8713a 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -29,7 +29,9 @@
  * in such scope than if not.  However, various libc functions called by Perl
  * are affected by the LC_NUMERIC category, so there are macros in perl.h that
  * are used to toggle between the current locale and the C locale depending on
- * the desired behavior of those functions at the moment.
+ * 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'.
  */
 
 #include "EXTERN.h"
@@ -190,13 +192,17 @@ Perl_new_numeric(pTHX_ const char *newnum)
     }
 
     save_newnum = stdize_locale(savepv(newnum));
+
+    PL_numeric_standard = isNAME_C_OR_POSIX(save_newnum);
+    PL_numeric_local = TRUE;
+
     if (! PL_numeric_name || strNE(PL_numeric_name, save_newnum)) {
        Safefree(PL_numeric_name);
        PL_numeric_name = save_newnum;
     }
-
-    PL_numeric_standard = isNAME_C_OR_POSIX(save_newnum);
-    PL_numeric_local = TRUE;
+    else {
+       Safefree(save_newnum);
+    }
 
     /* Keep LC_NUMERIC in the C locale.  This is for XS modules, so they don't
      * have to worry about the radix being a non-dot.  (Core operations that
@@ -1803,13 +1809,21 @@ Perl__is_in_locale_category(pTHX_ const bool compiling, const int category)
 
 char *
 Perl_my_strerror(pTHX_ const int errnum) {
+    dVAR;
 
     /* Uses C locale for the error text unless within scope of 'use locale' for
      * LC_MESSAGES */
 
 #ifdef USE_LOCALE_MESSAGES
     if (! IN_LC(LC_MESSAGES)) {
-        char * save_locale = setlocale(LC_MESSAGES, NULL);
+        char * save_locale;
+
+        /* We have a critical section to prevent another thread from changing
+         * the locale out from under us (or zapping the buffer returned from
+         * setlocale() ) */
+        LOCALE_LOCK;
+
+        save_locale = setlocale(LC_MESSAGES, NULL);
         if (! isNAME_C_OR_POSIX(save_locale)) {
             char *errstr;
 
@@ -1824,8 +1838,13 @@ Perl_my_strerror(pTHX_ const int errnum) {
 
             setlocale(LC_MESSAGES, save_locale);
             Safefree(save_locale);
+
+            LOCALE_UNLOCK;
+
             return errstr;
         }
+
+        LOCALE_UNLOCK;
     }
 #endif