diff options
author | Karl Williamson <public@khwilliamson.com> | 2013-06-22 12:49:01 -0600 |
---|---|---|
committer | Karl Williamson <public@khwilliamson.com> | 2013-07-07 13:29:44 -0600 |
commit | 28acfe03fc59abea4ef2451b134d560f411183ab (patch) | |
tree | e9ba297137a5aea6018e24c490d990c012860003 | |
parent | 7187d38ecd872451f4332f094b3d173fe8d57255 (diff) | |
download | perl-28acfe03fc59abea4ef2451b134d560f411183ab.tar.gz |
PATCH: [perl #118197] Cope with non-ASCII decimal separators
This patch causes the radix string to be examined upon a new numeric
locale being set. If the string isn't ASCII, and the new locale is
UTF-8, it turns on the UTF-8 flag in the scalar that holds the radix.
When a floating point number is formatted in Perl_sv_vcatpvfn_flags(),
and the flag is on, the result's flag will be set on too.
-rw-r--r-- | lib/locale.t | 25 | ||||
-rw-r--r-- | locale.c | 6 | ||||
-rw-r--r-- | sv.c | 16 |
3 files changed, 46 insertions, 1 deletions
diff --git a/lib/locale.t b/lib/locale.t index 79c2fd9436..081783b698 100644 --- a/lib/locale.t +++ b/lib/locale.t @@ -1015,6 +1015,8 @@ foreach $Locale (@Locale) { my $ok12; my $ok13; my $ok14; + my $ok15; + my $ok16; my $c; my $d; @@ -1070,7 +1072,7 @@ foreach $Locale (@Locale) { $ok11 = $f == $c; $ok12 = abs(($f + $g) - 3.57) < 0.01; $ok13 = $w == 0; - $ok14 = 1; # Skip for non-utf8 locales + $ok14 = $ok15 = $ok16 = 1; # Skip for non-utf8 locales } } else { @@ -1134,6 +1136,21 @@ foreach $Locale (@Locale) { last; } } + + # Similarly, we verify that a non-ASCII radix is in UTF-8. This + # also catches if there is a disparity between sprintf and + # stringification. + + my $string_g = "$g"; + + my $utf8_string_g = "$g"; + utf8::upgrade($utf8_string_g); + + my $utf8_sprintf_g = sprintf("%g", $g); + utf8::upgrade($utf8_sprintf_g); + use bytes; + $ok15 = $utf8_string_g eq $string_g; + $ok16 = $utf8_sprintf_g eq $string_g; } } @@ -1190,6 +1207,12 @@ foreach $Locale (@Locale) { tryneoalpha($Locale, ++$locales_test_number, $ok14); $test_names{$locales_test_number} = 'Verify that non-ASCII UTF-8 error messages are in UTF-8'; + tryneoalpha($Locale, ++$locales_test_number, $ok15); + $test_names{$locales_test_number} = 'Verify that a number with a UTF-8 radix has a UTF-8 stringification'; + + tryneoalpha($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'; + debug "# $first_f_test..$locales_test_number: \$f = $f, \$g = $g, back to locale = $Locale\n"; # Does taking lc separately differ from taking @@ -94,6 +94,12 @@ Perl_set_numeric_radix(pTHX) sv_setpv(PL_numeric_radix_sv, lc->decimal_point); else PL_numeric_radix_sv = newSVpv(lc->decimal_point, 0); + if (! is_ascii_string((U8 *) lc->decimal_point, 0) + && is_utf8_string((U8 *) lc->decimal_point, 0) + && is_cur_LC_category_utf8(LC_NUMERIC)) + { + SvUTF8_on(PL_numeric_radix_sv); + } } } else @@ -2930,6 +2930,15 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags) * TRUE in that case), no need to do any changing */ if (PL_numeric_standard || IN_SOME_LOCALE_FORM_RUNTIME) { Gconvert(SvNVX(sv), NV_DIG, 0, s); + + /* If the radix character is UTF-8, and actually is in the + * output, turn on the UTF-8 flag for the scalar */ + if (! PL_numeric_standard + && PL_numeric_radix_sv && SvUTF8(PL_numeric_radix_sv) + && instr(s, SvPVX_const(PL_numeric_radix_sv))) + { + SvUTF8_on(sv); + } } else { char *loc = savepv(setlocale(LC_NUMERIC, NULL)); @@ -2937,6 +2946,7 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags) Gconvert(SvNVX(sv), NV_DIG, 0, s); setlocale(LC_NUMERIC, loc); Safefree(loc); + } /* We don't call SvPOK_on(), because it may come to pass that the @@ -11275,6 +11285,12 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p } float_converted: eptr = PL_efloatbuf; + if (PL_numeric_radix_sv && SvUTF8(PL_numeric_radix_sv) + && instr(eptr, SvPVX_const(PL_numeric_radix_sv))) + { + is_utf8 = TRUE; + } + break; /* SPECIAL */ |