From e46375fad0ed9a24f5a8fbd13c2f6568d9b8eec9 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 24 Aug 2013 12:59:46 -0600 Subject: [PATCH] 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. --- lib/locale.t | 27 +++++++++++++++++++++++++++ pod/perldelta.pod | 24 +++++++++++++++++------- sv.c | 26 ++++++++++++++++++++++++++ 3 files changed, 70 insertions(+), 7 deletions(-) diff --git a/lib/locale.t b/lib/locale.t index 065f001..d0d6963 100644 --- 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 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -37,13 +37,23 @@ L 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 below. - -[ List each incompatible change as a =head2 entry ] +=head2 Locale decimal point character no longer leaks outside of S> 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>. 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 and C not +respecting S>. If your code is affected by this change, +simply add a S>. + +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 --- 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 } /* ========================================================================= -- 2.7.4