Merge branch 'bring unicode properties into core' into blead

[perl5.git] / vutil.c

diff --git a/vutil.c b/vutil.c
index af5f263..5d183a0 100644 (file)
--- a/vutil.c
+++ b/vutil.c
@@ -620,12 +620,16 @@ VER_NV:
 #endif
 #ifdef USE_LOCALE_NUMERIC
 
-        {
+       {
             /* This may or may not be called from code that has switched
              * 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,31 +645,90 @@ 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();
 
 #endif
 
-            if (sv) {
+       if (sv) {
                 Perl_sv_catpvf(aTHX_ sv, "%.9" NVff, SvNVX(ver));
-                len = SvCUR(sv);
-                buf = SvPVX(sv);
-            }
-            else {
+           len = SvCUR(sv);
+           buf = SvPVX(sv);
+       }
+       else {
                 len = my_snprintf(tbuf, sizeof(tbuf), "%.9" NVff, SvNVX(ver));
-                buf = tbuf;
-            }
+           buf = tbuf;
+       }
 
 #ifdef USE_LOCALE_NUMERIC
 
             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 */