locale.c: Be sure to toggle into dot radix locale

This fixes GH #21746

Perl keeps the LC_NUMERIC category in a locale where the radix character
is a dot, regardless of what the user has requested.  This is because
much XS code has been written with the dot assumption.  When the user's
actual radix character is desired, the locale is briefly toggled to that
one for the duration of the operation.

When the user changes the LC_NUMERIC locale, the new one is noted, but
the attempted change is otherwise ignored unless its radix is a dot.
The new one will be briefly toggled into when appropriate.

The blamed commit contains a logic error

commit 818cdb7aa9f85227c1c7313257c6204c872beb94
Author:     Karl Williamson <khw@cpan.org>
AuthorDate: Sun Apr 11 05:57:07 2021 -0600
Commit:     Karl Williamson <khw@cpan.org>
CommitDate: Thu Sep 1 09:02:04 2022 -0600

    locale.c: Skip code if will be a no-op

It decided it was a no-op if the new locale that the user is changing to
is the same as the previous locale.  But it didn't consider that what
actually happens is that the new locale does actually get changed, and
this code is supposed to make sure that, before returning control to the
user, that a dot radix locale is in effect.

If the new locale is a dot radix locale, then no harm is done by
skipping the code, but otherwise things can go wrong.

I am chagrined that I made this logic error without noticing before it
got pushed, and am surprised that it took this long for the error to
surrface.  There must be something else intervening to make this not a
problem in most circumstances, but I haven't analyzed what it might be.

The details as to why it happened in this test case are pretty obscure.
The locale in effect is looking for a comma radix, but what is being
checked for is a Perl version number, like 5.0936.  When converting that
to a floating point number, the dot is not recognized, and only the
initial '5' is found.  The failing code in a module has different
actions depending on the current perl version it is being called from,
and the conditional got the answer wrong because 5 is less than 5.0936,
whereas the actual version is above that.  So it did the wrong thing and
caused an error.

diff --git a/locale.c b/locale.c
index f0b74e4..f980c05 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -3393,10 +3393,26 @@ S_new_numeric(pTHX_ const char *newnum, bool force)
                            "Called new_numeric with %s, PL_numeric_name=%s\n",
                            newnum, PL_numeric_name));
 
-    /* If not forcing this procedure, and there isn't actually a change from
-     * our records, do nothing.  (Our records can be wrong when sync'ing to the
-     * locale set up by an external library, hence the 'force' parameter) */
+    /* We keep records comparing the characteristics of the LC_NUMERIC catetory
+     * of the current locale vs the standard C locale.  If the new locale that
+     * has just been changed to is the same as the one our records are for,
+     * they are still valid, and we don't have to recalculate them.  'force' is
+     * true if the caller suspects that the records are out-of-date, so do go
+     * ahead and recalculate them.  (This can happen when an external library
+     * has had control and now perl is reestablishing control; we have to
+     * assume that that library changed the locale in unknown ways.)
+     *
+     * Even if our records are valid, the new locale will likely have been
+     * switched to before this function gets called, and we must toggle into
+     * one indistinguishable from the C locale with regards to LC_NUMERIC
+     * handling, so that all the libc functions that are affected by LC_NUMERIC
+     * will work as expected.  This can be skipped if we already know that the
+     * locale is indistinguishable from the C locale. */
     if (! force && strEQ(PL_numeric_name, newnum)) {
+        if (! PL_numeric_underlying_is_standard) {
+            set_numeric_standard(__FILE__, __LINE__);
+        }
+
         return;
     }
 

diff --git a/t/run/locale.t b/t/run/locale.t
index 6634784..c532499 100644 (file)
--- a/t/run/locale.t
+++ b/t/run/locale.t
@@ -491,6 +491,18 @@ EOF
                 "1.5", { stderr => 'devnull' }, "POSIX::strtod() uses underlying locale");
             }
           }
+
+          { # GH #21746
+                local $ENV{LANG} = $comma;
+                fresh_perl_is(<<"EOF",
+                    use POSIX;
+                    POSIX::setlocale(POSIX::LC_ALL(),'');
+                    eval q{ use constant X => \$] };
+                    print \$@;
+EOF
+                "", {},
+                "Properly toggles to radix dot locale");
+          }
         }
     }