|
 |
292b33 |
From 78787052b6a68c0f54cfa983a69c44276de9daa4 Mon Sep 17 00:00:00 2001
|
|
|
292b33 |
From: Jesse Luehrs <doy@tozt.net>
|
|
|
292b33 |
Date: Tue, 26 Jun 2012 00:13:54 -0500
|
|
|
292b33 |
Subject: [PATCH] use a less broken test for locale radix in atof [perl #109318]
|
|
|
292b33 |
|
|
|
292b33 |
---
|
|
|
292b33 |
lib/locale.t | 33 +++++++++++++++++++++++++++++++++
|
|
|
292b33 |
numeric.c | 25 +++++++++++++++----------
|
|
|
292b33 |
2 files changed, 48 insertions(+), 10 deletions(-)
|
|
|
292b33 |
|
|
|
292b33 |
diff --git a/lib/locale.t b/lib/locale.t
|
|
|
292b33 |
index dfc6d2b..26a7bd4 100644
|
|
|
292b33 |
--- a/lib/locale.t
|
|
|
292b33 |
+++ b/lib/locale.t
|
|
|
292b33 |
@@ -1247,6 +1247,39 @@ foreach $Locale (@Locale) {
|
|
|
292b33 |
print "# failed $locales_test_number locale '$Locale' characters @f\n"
|
|
|
292b33 |
}
|
|
|
292b33 |
}
|
|
|
292b33 |
+
|
|
|
292b33 |
+ # [perl #109318]
|
|
|
292b33 |
+ {
|
|
|
292b33 |
+ my @f = ();
|
|
|
292b33 |
+ ++$locales_test_number;
|
|
|
292b33 |
+ $test_names{$locales_test_number} = 'Verify atof with locale radix and negative exponent';
|
|
|
292b33 |
+
|
|
|
292b33 |
+ my $radix = POSIX::localeconv()->{decimal_point};
|
|
|
292b33 |
+ my @nums = (
|
|
|
292b33 |
+ "3.14e+9", "3${radix}14e+9", "3.14e-9", "3${radix}14e-9",
|
|
|
292b33 |
+ "-3.14e+9", "-3${radix}14e+9", "-3.14e-9", "-3${radix}14e-9",
|
|
|
292b33 |
+ );
|
|
|
292b33 |
+
|
|
|
292b33 |
+ if (! $is_utf8_locale) {
|
|
|
292b33 |
+ use locale;
|
|
|
292b33 |
+ for my $num (@nums) {
|
|
|
292b33 |
+ push @f, $num
|
|
|
292b33 |
+ unless sprintf("%g", $num) =~ /3.+14/;
|
|
|
292b33 |
+ }
|
|
|
292b33 |
+ }
|
|
|
292b33 |
+ else {
|
|
|
292b33 |
+ use locale ':not_characters';
|
|
|
292b33 |
+ for my $num (@nums) {
|
|
|
292b33 |
+ push @f, $num
|
|
|
292b33 |
+ unless sprintf("%g", $num) =~ /3.+14/;
|
|
|
292b33 |
+ }
|
|
|
292b33 |
+ }
|
|
|
292b33 |
+
|
|
|
292b33 |
+ tryneoalpha($Locale, $locales_test_number, @f == 0);
|
|
|
292b33 |
+ if (@f) {
|
|
|
292b33 |
+ print "# failed $locales_test_number locale '$Locale' numbers @f\n"
|
|
|
292b33 |
+ }
|
|
|
292b33 |
+ }
|
|
|
292b33 |
}
|
|
|
292b33 |
|
|
|
292b33 |
my $final_locales_test_number = $locales_test_number;
|
|
|
292b33 |
diff --git a/numeric.c b/numeric.c
|
|
|
292b33 |
index be86f3a..3eb8a0e 100644
|
|
|
292b33 |
--- a/numeric.c
|
|
|
292b33 |
+++ b/numeric.c
|
|
|
292b33 |
@@ -847,17 +847,22 @@ Perl_my_atof(pTHX_ const char* s)
|
|
|
292b33 |
|
|
|
292b33 |
PERL_ARGS_ASSERT_MY_ATOF;
|
|
|
292b33 |
|
|
|
292b33 |
- if (PL_numeric_local && IN_SOME_LOCALE_FORM) {
|
|
|
292b33 |
- NV y;
|
|
|
292b33 |
+ if (PL_numeric_local && PL_numeric_radix_sv && IN_SOME_LOCALE_FORM) {
|
|
|
292b33 |
+ char *standard = NULL, *local = NULL;
|
|
|
292b33 |
+ bool use_standard_radix;
|
|
|
292b33 |
|
|
|
292b33 |
- /* Scan the number twice; once using locale and once without;
|
|
|
292b33 |
- * choose the larger result (in absolute value). */
|
|
|
292b33 |
- Perl_atof2(s, x);
|
|
|
292b33 |
- SET_NUMERIC_STANDARD();
|
|
|
292b33 |
- Perl_atof2(s, y);
|
|
|
292b33 |
- SET_NUMERIC_LOCAL();
|
|
|
292b33 |
- if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
|
|
|
292b33 |
- return y;
|
|
|
292b33 |
+ standard = strchr(s, '.');
|
|
|
292b33 |
+ local = strstr(s, SvPV_nolen(PL_numeric_radix_sv));
|
|
|
292b33 |
+
|
|
|
292b33 |
+ use_standard_radix = standard && (!local || standard < local);
|
|
|
292b33 |
+
|
|
|
292b33 |
+ if (use_standard_radix)
|
|
|
292b33 |
+ SET_NUMERIC_STANDARD();
|
|
|
292b33 |
+
|
|
|
292b33 |
+ Perl_atof2(s, x);
|
|
|
292b33 |
+
|
|
|
292b33 |
+ if (use_standard_radix)
|
|
|
292b33 |
+ SET_NUMERIC_LOCAL();
|
|
|
292b33 |
}
|
|
|
292b33 |
else
|
|
|
292b33 |
Perl_atof2(s, x);
|
|
|
292b33 |
--
|
|
|
292b33 |
1.7.4.1
|
|
|
292b33 |
|