PATCH: [perl #108378] [perl #115800]
authorKarl Williamson <public@khwilliamson.com>
Mon, 13 May 2013 13:35:35 +0000 (07:35 -0600)
committerKarl Williamson <public@khwilliamson.com>
Tue, 18 Jun 2013 05:25:21 +0000 (23:25 -0600)
This patch solves two tickets.  Both are a result of the stringification
of a floating number being sticky, so that the character representing
the decimal point may be from an old locale.  The patch solves this by
not retaining the stringification of NVs.

lib/version/t/07locale.t
sv.c

index 3b67f3d..2628c46 100644 (file)
@@ -7,7 +7,7 @@
 use File::Basename;
 use File::Temp qw/tempfile/;
 use POSIX qw/locale_h/;
-use Test::More tests => 7;
+use Test::More tests => 9;
 use Config;
 
 BEGIN {
@@ -15,10 +15,11 @@ BEGIN {
 }
 
 SKIP: {
-       skip 'No locale testing for Perl < 5.6.0', 6 if $] < 5.006;
-        skip 'No locale testing without d_setlocale', 6 if(!$Config{d_setlocale});
+        skip 'No locale testing for Perl < 5.6.0', 8 if $] < 5.006;
+        skip 'No locale testing without d_setlocale', 8 if(!$Config{d_setlocale});
        # test locale handling
        my $warning;
+
        local $SIG{__WARN__} = sub { $warning = $_[0] };
 
        my $ver = 1.23;  # has to be floating point number
@@ -30,19 +31,27 @@ SKIP: {
            $loc = setlocale( LC_ALL, $_);
            last if localeconv()->{decimal_point} eq ',';
        }
-       skip 'Cannot test locale handling without a comma locale', 5
+       skip 'Cannot test locale handling without a comma locale', 7
            unless $loc and localeconv()->{decimal_point} eq ',';
 
        diag ("Testing locale handling with $loc") unless $ENV{PERL_CORE};
 
-       setlocale(LC_NUMERIC, $loc);
-       is ($ver, '1,23', "Using locale: $loc");
+        setlocale(LC_NUMERIC, $loc);
+       ok ("$ver eq '1,23'", "Using locale: $loc");
        $v = version->new($ver);
        unlike($warning, qr/Version string '1,23' contains invalid data/,
            "Process locale-dependent floating point");
-       is ($v, "1.23", "Locale doesn't apply to version objects");
+       ok ($v == "1.23", "Locale doesn't apply to version objects");
        ok ($v == $ver, "Comparison to locale floating point");
 
+        {
+            no locale;
+            ok ("$ver eq '1.23'", "Outside of scope of use locale");
+        }
+
+        ok("\"$ver\"+1 gt 2.22" && \"$ver\"+1 lt 2.24",
+           "Can do math when radix is not a dot");  # [perl 115800]
+
        setlocale( LC_ALL, $orig_loc); # reset this before possible skip
        skip 'Cannot test RT#46921 with Perl < 5.008', 1
            if ($] < 5.008);
diff --git a/sv.c b/sv.c
index d10e5a5..a8f15ce 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2903,6 +2903,7 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
        Move(ptr, s, len, char);
        s += len;
        *s = '\0';
+        SvPOK_on(sv);
     }
     else if (SvNOK(sv)) {
        if (SvTYPE(sv) < SVt_PVNV)
@@ -2916,7 +2917,15 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
            /* The +20 is pure guesswork.  Configure test needed. --jhi */
            s = SvGROW_mutable(sv, NV_DIG + 20);
            /* some Xenix systems wipe out errno here */
-           Gconvert(SvNVX(sv), NV_DIG, 0, s);
+
+            Gconvert(SvNVX(sv), NV_DIG, 0, s);
+#ifndef USE_LOCALE_NUMERIC
+            /* We don't call SvPOK_on() if there are locales, because it may
+             * come to pass that the locale changes so that the stringification
+             * we just did is no longer correct.  We will have to re-stringify
+             * every time it is needed */
+            SvPOK_on(sv);
+#endif
            RESTORE_ERRNO;
            while (*s) s++;
        }
@@ -2961,7 +2970,6 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags)
            *lp = len;
        SvCUR_set(sv, len);
     }
-    SvPOK_on(sv);
     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n",
                          PTR2UV(sv),SvPVX_const(sv)));
     if (flags & SV_CONST_RETURN)