Avoid some unnecessary changing of locales

The LC_NUMERIC locale category is kept so that generally the decimal
point (radix) is a dot.  For some (mostly) output purposes, it needs to
be swapped into the program's current underlying locale so that a
non-dot can be printed.

This commit changes things so that if the current underlying locale uses
a decimal point, the swap doesn't happen, as it's not needed.

diff --git a/embedvar.h b/embedvar.h
index 0922ee4..d97f493 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -221,6 +221,7 @@
 #define PL_numeric_radix_sv    (vTHX->Inumeric_radix_sv)
 #define PL_numeric_standard    (vTHX->Inumeric_standard)
 #define PL_numeric_underlying  (vTHX->Inumeric_underlying)
+#define PL_numeric_underlying_is_standard      (vTHX->Inumeric_underlying_is_standard)
 #define PL_ofsgv               (vTHX->Iofsgv)
 #define PL_oldname             (vTHX->Ioldname)
 #define PL_op                  (vTHX->Iop)

diff --git a/intrpvar.h b/intrpvar.h
index 2df01a3..cbb7891 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -614,6 +614,7 @@ PERLVARI(I, numeric_standard, int, TRUE)
                                        /* Assume C locale numerics */
 PERLVARI(I, numeric_underlying, bool, TRUE)
                                        /* Assume underlying locale numerics */
+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 '.' */
 

diff --git a/locale.c b/locale.c
index dd7d1d3..cfc4805 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -452,13 +452,17 @@ Perl_new_numeric(pTHX_ const char *newnum)
      *                  that the current locale is the program's underlying
      *                  locale
      * PL_numeric_standard An int indicating if the toggled state is such
-     *                  that the current locale is the C locale.  If non-zero,
-     *                  it is in C; if > 1, it means it may not be toggled away
+     *                  that the current locale is the C locale or
+     *                  indistinguishable from the C locale.  If non-zero, it
+     *                  is in C; if > 1, it means it may not be toggled away
      *                  from C.
-     * Note that both of the last two variables can be true at the same time,
-     * if the underlying locale is C.  (Toggling is a no-op under these
-     * circumstances.)
-     *
+     * PL_numeric_underlying_is_standard   A bool kept by this function
+     *                  indicating that the underlying locale and the standard
+     *                  C locale are indistinguishable for the purposes of
+     *                  LC_NUMERIC.  This happens when both of the above two
+     *                  variables are true at the same time.  (Toggling is a
+     *                  no-op under these circumstances.)  This variable is
+     *                  used to avoid having to recalculate.
      * Any code changing the locale (outside this file) should use
      * POSIX::setlocale, which calls this function.  Therefore this function
      * should be called directly only from this file and from
@@ -471,14 +475,24 @@ Perl_new_numeric(pTHX_ const char *newnum)
        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));
-
-    PL_numeric_standard = isNAME_C_OR_POSIX(save_newnum);
     PL_numeric_underlying = TRUE;
+    PL_numeric_standard = isNAME_C_OR_POSIX(save_newnum);
+
+    /* If its name isn't C nor POSIX, it could still be indistinguishable from
+     * them */
+    if (! PL_numeric_standard) {
+        PL_numeric_standard = cBOOL(strEQ(".", my_nl_langinfo(PERL_RADIXCHAR,
+                                            FALSE /* Don't toggle locale */  ))
+                                 && strEQ("",  my_nl_langinfo(PERL_THOUSEP,
+                                                              FALSE)));
+    }
 
+    /* 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;
@@ -487,6 +501,12 @@ Perl_new_numeric(pTHX_ const char *newnum)
        Safefree(save_newnum);
     }
 
+    PL_numeric_underlying_is_standard = PL_numeric_standard;
+
+    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);
+    }
+
     /* 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
      * need the underlying locale change to it temporarily). */
@@ -510,7 +530,7 @@ Perl_set_numeric_standard(pTHX)
 
     do_setlocale_c(LC_NUMERIC, "C");
     PL_numeric_standard = TRUE;
-    PL_numeric_underlying = isNAME_C_OR_POSIX(PL_numeric_name);
+    PL_numeric_underlying = PL_numeric_underlying_is_standard;
     set_numeric_radix(0);
 
 #  ifdef DEBUGGING
@@ -538,7 +558,7 @@ Perl_set_numeric_underlying(pTHX)
      * wrong if some XS code has changed the locale behind our back) */
 
     do_setlocale_c(LC_NUMERIC, PL_numeric_name);
-    PL_numeric_standard = isNAME_C_OR_POSIX(PL_numeric_name);
+    PL_numeric_standard = PL_numeric_underlying_is_standard;
     PL_numeric_underlying = TRUE;
     set_numeric_radix(1);
 

diff --git a/perl.h b/perl.h
index d1d6ea5..6038a73 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -5773,6 +5773,11 @@ expression, but with an empty argument list, like this:
  * The other is non-zero if the current locale is the underlying locale.  Both
  * can be non-zero if, as often happens, the underlying locale is C.
  *
+ * Its slightly more complicated than this, as the PL_numeric_standard variable
+ * is set if the current numeric locale is indistinguishable from the C locale.
+ * This happens when the radix character is a dot, and the thousands separator
+ * is the empty string.
+ *
  * khw believes the reason for the variables instead of the bits in a single
  * word is to avoid having to have masking instructions. */
 

diff --git a/sv.c b/sv.c
index ccb7657..a4c23ea 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -15223,6 +15223,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 #ifdef USE_LOCALE_NUMERIC
     PL_numeric_standard        = proto_perl->Inumeric_standard;
     PL_numeric_underlying      = proto_perl->Inumeric_underlying;
+    PL_numeric_underlying_is_standard  = proto_perl->Inumeric_underlying_is_standard;
 #endif /* !USE_LOCALE_NUMERIC */
 
     /* Did the locale setup indicate UTF-8? */