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.

diff --git a/lib/locale.t b/lib/locale.t
index 79c2fd9..081783b 100644 (file)
--- 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

diff --git a/locale.c b/locale.c
index 1fd6fde..5223a89 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -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

diff --git a/sv.c b/sv.c
index a42b4a8..183b60b 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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 */