Blob Blame History Raw
From 78787052b6a68c0f54cfa983a69c44276de9daa4 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Tue, 26 Jun 2012 00:13:54 -0500
Subject: [PATCH] use a less broken test for locale radix in atof [perl #109318]

---
 lib/locale.t |   33 +++++++++++++++++++++++++++++++++
 numeric.c    |   25 +++++++++++++++----------
 2 files changed, 48 insertions(+), 10 deletions(-)

diff --git a/lib/locale.t b/lib/locale.t
index dfc6d2b..26a7bd4 100644
--- a/lib/locale.t
+++ b/lib/locale.t
@@ -1247,6 +1247,39 @@ foreach $Locale (@Locale) {
 	    print "# failed $locales_test_number locale '$Locale' characters @f\n"
 	}
     }
+
+    # [perl #109318]
+    {
+        my @f = ();
+        ++$locales_test_number;
+        $test_names{$locales_test_number} = 'Verify atof with locale radix and negative exponent';
+
+        my $radix = POSIX::localeconv()->{decimal_point};
+        my @nums = (
+             "3.14e+9",  "3${radix}14e+9",  "3.14e-9",  "3${radix}14e-9",
+            "-3.14e+9", "-3${radix}14e+9", "-3.14e-9", "-3${radix}14e-9",
+        );
+
+        if (! $is_utf8_locale) {
+            use locale;
+            for my $num (@nums) {
+                push @f, $num
+                    unless sprintf("%g", $num) =~ /3.+14/;
+            }
+        }
+        else {
+            use locale ':not_characters';
+            for my $num (@nums) {
+                push @f, $num
+                    unless sprintf("%g", $num) =~ /3.+14/;
+            }
+        }
+
+	tryneoalpha($Locale, $locales_test_number, @f == 0);
+	if (@f) {
+	    print "# failed $locales_test_number locale '$Locale' numbers @f\n"
+	}
+    }
 }
 
 my $final_locales_test_number = $locales_test_number;
diff --git a/numeric.c b/numeric.c
index be86f3a..3eb8a0e 100644
--- a/numeric.c
+++ b/numeric.c
@@ -847,17 +847,22 @@ Perl_my_atof(pTHX_ const char* s)
 
     PERL_ARGS_ASSERT_MY_ATOF;
 
-    if (PL_numeric_local && IN_SOME_LOCALE_FORM) {
-	NV y;
+    if (PL_numeric_local && PL_numeric_radix_sv && IN_SOME_LOCALE_FORM) {
+        char *standard = NULL, *local = NULL;
+        bool use_standard_radix;
 
-	/* Scan the number twice; once using locale and once without;
-	 * choose the larger result (in absolute value). */
-	Perl_atof2(s, x);
-	SET_NUMERIC_STANDARD();
-	Perl_atof2(s, y);
-	SET_NUMERIC_LOCAL();
-	if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
-	    return y;
+        standard = strchr(s, '.');
+        local = strstr(s, SvPV_nolen(PL_numeric_radix_sv));
+
+        use_standard_radix = standard && (!local || standard < local);
+
+        if (use_standard_radix)
+            SET_NUMERIC_STANDARD();
+
+        Perl_atof2(s, x);
+
+        if (use_standard_radix)
+            SET_NUMERIC_LOCAL();
     }
     else
 	Perl_atof2(s, x);
-- 
1.7.4.1