Avoid changing locale when finding radix char
authorKarl Williamson <khw@cpan.org>
Thu, 18 Jan 2018 23:20:02 +0000 (16:20 -0700)
committerKarl Williamson <khw@cpan.org>
Wed, 31 Jan 2018 05:58:15 +0000 (22:58 -0700)
On systems that have the POSIX 2008 operations, including
nl_langinfo_l(), this commit causes them to not have to actually change
the locale when determining what the decimal point character is.

The locale may have to change during the printing/reading of numbers,
but eventually we can use sprintf_l(), if available, to avoid that too.

embedvar.h
intrpvar.h
locale.c
perl.c
sv.c

index 5f34a5d..fe33c86 100644 (file)
 #define PL_tmps_stack          (vTHX->Itmps_stack)
 #define PL_top_env             (vTHX->Itop_env)
 #define PL_toptarget           (vTHX->Itoptarget)
+#define PL_underlying_numeric_obj      (vTHX->Iunderlying_numeric_obj)
 #define PL_unicode             (vTHX->Iunicode)
 #define PL_unitcheckav         (vTHX->Iunitcheckav)
 #define PL_unitcheckav_save    (vTHX->Iunitcheckav_save)
index 3cc8388..2bd43ab 100644 (file)
@@ -620,6 +620,11 @@ PERLVARI(I, numeric_underlying_is_standard, bool, TRUE)
 PERLVAR(I, numeric_name, char *)       /* Name of current numeric locale */
 PERLVAR(I, numeric_radix_sv, SV *)     /* The radix separator if not '.' */
 
+#  if defined(HAS_NEWLOCALE) && ! defined(NO_POSIX_2008_LOCALE)
+
+PERLVARI(I, underlying_numeric_obj, locale_t, NULL)
+
+#  endif
 #endif /* !USE_LOCALE_NUMERIC */
 
 /* Unicode inversion lists */
index 98c4d70..100be65 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -498,6 +498,14 @@ Perl_new_numeric(pTHX_ const char *newnum)
 
     PL_numeric_underlying_is_standard = PL_numeric_standard;
 
+#  if defined(HAS_NEWLOCALE) && ! defined(NO_POSIX_2008_LOCALE)
+
+    PL_underlying_numeric_obj = newlocale(LC_NUMERIC_MASK,
+                                          PL_numeric_name,
+                                          PL_underlying_numeric_obj);
+
+#endif
+
     if (DEBUG_L_TEST || debug_initialization) {
         PerlIO_printf(Perl_debug_log, "Called new_numeric with %s, PL_numeric_name=%s\n", newnum, PL_numeric_name);
     }
@@ -1456,8 +1464,13 @@ S_my_nl_langinfo(const int item, bool toggle)
         }
 
         if (toggle) {
-            cur = newlocale(LC_NUMERIC_MASK, PL_numeric_name, cur);
-            do_free = TRUE;
+            if (PL_underlying_numeric_obj) {
+                cur = PL_underlying_numeric_obj;
+            }
+            else {
+                cur = newlocale(LC_NUMERIC_MASK, PL_numeric_name, cur);
+                do_free = TRUE;
+            }
         }
 
         save_to_buffer(nl_langinfo_l(item, cur),
diff --git a/perl.c b/perl.c
index af0399d..96ad0f6 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1159,6 +1159,19 @@ perl_destruct(pTHXx)
         PL_langinfo_buf = NULL;
     }
 
+#ifdef USE_POSIX_2008_LOCALE
+#  ifdef USE_LOCALE_NUMERIC
+
+    if (PL_underlying_numeric_obj) {
+        /* Make sure we aren't using the locale space we are about to free */
+        uselocale(LC_GLOBAL_LOCALE);
+        freelocale(PL_underlying_numeric_obj);
+        PL_underlying_numeric_obj = (locale_t) NULL;
+    }
+
+#  endif
+#endif
+
     /* clear character classes  */
     for (i = 0; i < POSIX_SWASH_COUNT; i++) {
         SvREFCNT_dec(PL_utf8_swash_ptrs[i]);
diff --git a/sv.c b/sv.c
index 7717653..fa5295d 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -15560,6 +15560,10 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 #ifdef USE_LOCALE_NUMERIC
     PL_numeric_name    = SAVEPV(proto_perl->Inumeric_name);
     PL_numeric_radix_sv        = sv_dup_inc(proto_perl->Inumeric_radix_sv, param);
+
+#  if defined(HAS_NEWLOCALE) && ! defined(NO_POSIX_2008_LOCALE)
+    PL_underlying_numeric_obj = NULL;
+#  endif
 #endif /* !USE_LOCALE_NUMERIC */
 
     PL_langinfo_buf = NULL;