snprintf() calls need to have proper radix

Calls to libc snprintf() were neglected to be changed when perl was
fixed to change the radix character to the proper one based on whether
or not 'use locale' is in effect.  Perl-level code is unaffected, but
core and XS code is.

This commit changes to wrap snprintf() calls with the macros designed
for the purpose, long used for similar situations elsewhere in the code.

Doing this requires the thread context.  I achieved this in a few places
by a dTHX, instead of assuming a caller would have the context already
available, and adding a pTHX_ parameter.  I tried doing it the other
way, and got a few breakages in our test suite.  Formatting already
requires significant CPU time, so this addition should just be in the
noise

This bug was found by new tests that will be added in a future commit.

3 files changed, 54 insertions, 14 deletions

diff --git a/perl.h b/perl.h
index 40d43d8194..588f63d96c 100644
--- a/perl.h
+++ b/perl.h
@@ -2283,7 +2283,7 @@ my_snprintf()
 
 #define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && (Size_t)len > (max)) Perl_croak_nocontext("panic: %s buffer overflow", STRINGIFY(api)); } STMT_END
 
-#ifdef USE_QUADMATH
+#if defined(USE_LOCALE_NUMERIC) || defined(USE_QUADMATH)
 #  define my_snprintf Perl_my_snprintf
 #  define PERL_MY_SNPRINTF_GUARDED
 #elif defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
@@ -2300,9 +2300,16 @@ my_snprintf()
 
 /* There is no quadmath_vsnprintf, and therefore my_vsnprintf()
  * dies if called under USE_QUADMATH. */
-#if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC)
+#if !  defined(USE_LOCALE_NUMERIC)                                  \
+ &&    defined(HAS_VSNPRINTF)                                       \
+ &&    defined(HAS_C99_VARIADIC_MACROS)                             \
+ && ! (defined(DEBUGGING) && ! defined(PERL_USE_GCC_BRACE_GROUPS))  \
+ && !  defined(PERL_GCC_PEDANTIC)
 #  ifdef PERL_USE_GCC_BRACE_GROUPS
-#      define my_vsnprintf(buffer, max, ...) ({ int len = vsnprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, vsnprintf); len; })
+#      define my_vsnprintf(buffer, max, ...)                        \
+            ({ int len = vsnprintf(buffer, max, __VA_ARGS__);       \
+             PERL_SNPRINTF_CHECK(len, max, vsnprintf);              \
+             len; })
 #      define PERL_MY_VSNPRINTF_GUARDED
 #  else
 #    define my_vsnprintf(buffer, max, ...) vsnprintf(buffer, max, __VA_ARGS__)
diff --git a/perlio.c b/perlio.c
index 287b6e099b..c5ed3f0a64 100644
--- a/perlio.c
+++ b/perlio.c
@@ -369,7 +369,10 @@ PerlIO_debug(const char *fmt, ...)
            should be, otherwise the system isn't likely to support quadmath.
            Nothing should be calling PerlIO_debug() with floating point anyway.
         */
+        DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+        STORE_LC_NUMERIC_SET_TO_NEEDED();
         const STRLEN len2 = vsnprintf(buffer + len1, sizeof(buffer) - len1, fmt, ap);
+        RESTORE_LC_NUMERIC();
 #    else
         STATIC_ASSERT_STMT(0);
 #    endif
diff --git a/util.c b/util.c
index ebf5984d7c..8590b3a4bc 100644
--- a/util.c
+++ b/util.c
@@ -5194,11 +5194,14 @@ getting C<vsnprintf>.
 
 =cut
 */
+
 int
 Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...)
 {
     int retval = -1;
     va_list ap;
+    dTHX;
+
     PERL_ARGS_ASSERT_MY_SNPRINTF;
 #ifndef HAS_VSNPRINTF
     PERL_UNUSED_VAR(len);
@@ -5207,9 +5210,12 @@ Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...)
 #ifdef USE_QUADMATH
     {
         bool quadmath_valid = FALSE;
+
         if (quadmath_format_valid(format)) {
             /* If the format looked promising, use it as quadmath. */
-            retval = quadmath_snprintf(buffer, len, format, va_arg(ap, NV));
+            WITH_LC_NUMERIC_SET_TO_NEEDED(
+                retval = quadmath_snprintf(buffer, len, format, va_arg(ap, NV));
+            );
             if (retval == -1) {
                 Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", format);
             }
@@ -5241,12 +5247,20 @@ Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...)
 
     }
 #endif
-    if (retval == -1)
+    if (retval == -1) {
+
 #ifdef HAS_VSNPRINTF
-        retval = vsnprintf(buffer, len, format, ap);
+        WITH_LC_NUMERIC_SET_TO_NEEDED(
+            retval = vsnprintf(buffer, len, format, ap);
+        );
 #else
-        retval = vsprintf(buffer, format, ap);
+        WITH_LC_NUMERIC_SET_TO_NEEDED(
+            retval = vsprintf(buffer, format, ap);
+        );
 #endif
+
+    }
+
     va_end(ap);
     /* vsprintf() shows failure with < 0 */
     if (retval < 0
@@ -5271,6 +5285,7 @@ C<sv_vcatpvf> instead, or getting C<vsnprintf>.
 
 =cut
 */
+
 int
 Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap)
 {
@@ -5284,6 +5299,7 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap
     return 0;
 #else
     int retval;
+    dTHX;
 
 #  ifdef NEED_VA_COPY
     va_list apc;
@@ -5291,20 +5307,28 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap
     PERL_ARGS_ASSERT_MY_VSNPRINTF;
     Perl_va_copy(ap, apc);
 #    ifdef HAS_VSNPRINTF
-    retval = vsnprintf(buffer, len, format, apc);
-#    else
 
+    WITH_LC_NUMERIC_SET_TO_NEEDED(
+        retval = vsnprintf(buffer, len, format, apc);
+    );
+#    else
     PERL_UNUSED_ARG(len);
-    retval = vsprintf(buffer, format, apc);
+    WITH_LC_NUMERIC_SET_TO_NEEDED(
+        retval = vsprintf(buffer, format, apc);
+    );
 #    endif
 
     va_end(apc);
 #  else
 #    ifdef HAS_VSNPRINTF
-    retval = vsnprintf(buffer, len, format, ap);
+    WITH_LC_NUMERIC_SET_TO_NEEDED(
+        retval = vsnprintf(buffer, len, format, ap);
+    );
 #    else
     PERL_UNUSED_ARG(len);
-    retval = vsprintf(buffer, format, ap);
+    WITH_LC_NUMERIC_SET_TO_NEEDED(
+        retval = vsprintf(buffer, format, ap);
+    );
 #    endif
 #  endif /* #ifdef NEED_VA_COPY */
 
@@ -5317,6 +5341,7 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap
 #  endif
     )
         Perl_croak_nocontext("panic: my_vsnprintf buffer overflow");
+
     return retval;
 #endif
 }
@@ -6159,8 +6184,13 @@ static void atos_symbolize(atos_context* ctx,
             return;
         }
     }
-    cnt = snprintf(cmd, sizeof(cmd), ctx->format,
-                   ctx->fname, ctx->object_base_addr, raw_frame);
+
+    dTHX;
+    WITH_LC_NUMERIC_SET_TO_NEEDED(
+        cnt = snprintf(cmd, sizeof(cmd), ctx->format,
+                       ctx->fname, ctx->object_base_addr, raw_frame);
+    );
+
     if (cnt < sizeof(cmd)) {
         /* Undo nostdio.h #defines that disable stdio.
          * This is somewhat naughty, but is used elsewhere