Make printf, sprintf respect 'use locale' for radix

When called from outside the lexical scope of 'use locale', these now
always print a dot for the decimal point character.

This change is actually done in Perl_sv_vcatpvfn_flags, which is common
to many things, but the principal external effect that I could determine
is on printf and sprintf.

Without this change, unrelated code can change the locale, thus
affecting what an unsuspecting application prints.

diff --git a/lib/locale.t b/lib/locale.t
index 065f001..d0d6963 100644 (file)
--- a/lib/locale.t
+++ b/lib/locale.t
@@ -1574,12 +1574,17 @@ foreach $Locale (@Locale) {
     my $ok14;
     my $ok15;
     my $ok16;
+    my $ok17;
+    my $ok18;
 
     my $c;
     my $d;
     my $e;
     my $f;
     my $g;
+    my $h;
+    my $i;
+    my $j;
 
     if (! $is_utf8_locale) {
         use locale;
@@ -1623,6 +1628,9 @@ foreach $Locale (@Locale) {
 
             $f = "1.23";
             $g = 2.34;
+            $h = 1.5;
+            $i = 1.25;
+            $j = "$h:$i";
 
             $ok9 = $f == 1.23;
             $ok10 = $f == $x;
@@ -1631,6 +1639,11 @@ foreach $Locale (@Locale) {
             $ok13 = $w == 0;
             $ok14 = $ok15 = $ok16 = 1;  # Skip for non-utf8 locales
         }
+        {
+            no locale;
+            $ok17 = "1.5:1.25" eq sprintf("%g:%g", $h, $i);
+        }
+        $ok18 = $j eq sprintf("%g:%g", $h, $i);
     }
     else {
         use locale ':not_characters';
@@ -1667,6 +1680,9 @@ foreach $Locale (@Locale) {
 
             $f = "1.23";
             $g = 2.34;
+            $h = 1.5;
+            $i = 1.25;
+            $j = "$h:$i";
 
             $ok9 = $f == 1.23;
             $ok10 = $f == $x;
@@ -1709,6 +1725,11 @@ foreach $Locale (@Locale) {
             $ok15 = $utf8_string_g eq $string_g;
             $ok16 = $utf8_sprintf_g eq $string_g;
         }
+        {
+            no locale;
+            $ok17 = "1.5:1.25" eq sprintf("%g:%g", $h, $i);
+        }
+        $ok18 = $j eq sprintf("%g:%g", $h, $i);
     }
 
     report_result($Locale, ++$locales_test_number, $ok1);
@@ -1770,6 +1791,12 @@ foreach $Locale (@Locale) {
     report_result($Locale, ++$locales_test_number, $ok16);
     $test_names{$locales_test_number} = 'Verify that a sprintf of a number with a UTF-8 radix yields UTF-8';
 
+    report_result($Locale, ++$locales_test_number, $ok17);
+    $test_names{$locales_test_number} = 'Verify that a sprintf of a number outside locale scope uses a dot radix';
+
+    report_result($Locale, ++$locales_test_number, $ok18);
+    $test_names{$locales_test_number} = 'Verify that a sprintf of a number back within locale scope uses locale radix';
+
     debug "# $first_f_test..$locales_test_number: \$f = $f, \$g = $g, back to locale = $Locale\n";
 
     # Does taking lc separately differ from taking

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 775a069..fc07985 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -37,13 +37,23 @@ L</Selected Bug Fixes> section.
 
 =head1 Incompatible Changes
 
-XXX For a release on a stable branch, this section aspires to be:
-
-    There are no changes intentionally incompatible with 5.XXX.XXX
-    If any exist, they are bugs, and we request that you submit a
-    report.  See L</Reporting Bugs> below.
-
-[ List each incompatible change as a =head2 entry ]
+=head2 Locale decimal point character no longer leaks outside of S<C<use locale>> scope
+(with the exception of C<$!>)
+
+This is actually a bug fix, but some code has come to rely on the bug
+being present, so this change is listed here.  The current locale that
+the program is running under is not supposed to be visible to Perl code
+except within the scope of a S<C<use locale>>.  However, until now under
+certain circumstances, the character used for a decimal point (often a
+comma) leaked outside the scope.
+
+This continues the work released in Perl v5.19.1.  It turns out that
+that did not catch all the leaks, including C<printf> and C<sprintf> not
+respecting S<C<use locale>>.  If your code is affected by this change,
+simply add a S<C<use locale>>.
+
+Now, the only known place where C<'use locale'> is not respected is in
+the stringification of L<$!|perlvar/$!>.
 
 =head1 Deprecations
 

diff --git a/sv.c b/sv.c
index 4176471..f53ffdd 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10382,6 +10382,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
     char ebuf[IV_DIG * 4 + NV_DIG + 32];
     /* large enough for "%#.#f" --chip */
     /* what about long double NVs? --jhi */
+#ifdef USE_LOCALE_NUMERIC
+    SV* oldlocale = NULL;
+#endif
 
     PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS;
     PERL_UNUSED_ARG(maybe_tainted);
@@ -11342,6 +11345,21 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                /* No taint.  Otherwise we are in the strange situation
                 * where printf() taints but print($float) doesn't.
                 * --jhi */
+
+#ifdef USE_LOCALE_NUMERIC
+                if (! PL_numeric_standard && ! IN_SOME_LOCALE_FORM) {
+
+                    /* We use a mortal SV, so that any failures (such as if
+                     * warnings are made fatal) won't leak */
+                    char *oldlocale_string = setlocale(LC_NUMERIC, NULL);
+                    oldlocale = newSVpvn_flags(oldlocale_string,
+                                               strlen(oldlocale_string),
+                                               SVs_TEMP);
+                    PL_numeric_standard = TRUE;
+                    setlocale(LC_NUMERIC, "C");
+                }
+#endif
+
 #if defined(HAS_LONG_DOUBLE)
                elen = ((intsize == 'q')
                        ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, nv)
@@ -11517,6 +11535,14 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
        }
     }
     SvTAINT(sv);
+
+#ifdef USE_LOCALE_NUMERIC   /* Done outside loop, so don't have to save/restore
+                               each iteration. */
+    if (oldlocale) {
+        setlocale(LC_NUMERIC, SvPVX(oldlocale));
+        PL_numeric_standard = FALSE;
+    }
+#endif
 }
 
 /* =========================================================================