From 906f284febf43a7190682e42c5aef12275cef5ce Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Sat, 9 Jun 2001 23:37:36 +0100 Subject: [PATCH] Try to grok numbers both with the locale specific separator and with the usual "." (if different from the lss); add a test to locale.t to do also a little bit of math in addition to just equalness testing; remove extraneous logic as suggested in Subject: Re: pragma/locale.t #107 Message-ID: <20010609223735.Y76396@plum.flirble.org> p4raw-id: //depot/perl@10494 --- sv.c | 86 ++++++++++++++++++++++++++++------------------- t/pragma/locale.t | 33 +++++++++++------- 2 files changed, 72 insertions(+), 47 deletions(-) diff --git a/sv.c b/sv.c index aeb471d1ae..2a843e6a5c 100644 --- a/sv.c +++ b/sv.c @@ -1505,7 +1505,7 @@ S_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) int sawinf = 0; char* radix = "."; STRLEN radixlen = 1; - + bool radixfound; while (isSPACE(*s)) s++; @@ -1589,44 +1589,64 @@ S_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) *valuep = value; skip_value: - if (s + radixlen <= send && memEQ(s, radix, radixlen)) { + if (s + radixlen <= send && memEQ(s, radix, radixlen)) + radixfound = TRUE; +#ifdef USE_LOCALE_NUMERIC + /* if we did change the radix and the radix is not the "." + * retry with the "." (in case of mixed data) */ + else if (IN_LOCALE && !(*radix == '.' && radixlen == 1) && *s == '.') { + radixlen = 1; + radixfound = TRUE; + } +#endif + if (radixfound) { s += radixlen; numtype |= IS_NUMBER_NOT_INT; while (isDIGIT(*s)) /* optional digits after the radix */ s++; } } - else if (s + radixlen <= send && memEQ(s, radix, radixlen)) { - s += radixlen; - numtype |= IS_NUMBER_NOT_INT; - /* no digits before the radix means we need digits after it */ - if (isDIGIT(*s)) { - do { - s++; - } while (isDIGIT(*s)); - numtype |= IS_NUMBER_IN_UV; - if (valuep) { - /* integer approximation is valid - it's 0. */ - *valuep = 0; - } - } - else - return 0; - } - else if (*s == 'I' || *s == 'i') { - s++; if (*s != 'N' && *s != 'n') return 0; - s++; if (*s != 'F' && *s != 'f') return 0; - s++; if (*s == 'I' || *s == 'i') { + else { + if (s + radixlen <= send && memEQ(s, radix, radixlen)) + radixfound = TRUE; +#ifdef USE_LOCALE_NUMERIC + else if (IN_LOCALE && !(*radix == '.' && radixlen == 1) && *s == '.') { + radixlen = 1; + radixfound = TRUE; + } +#endif + if (radixfound) { + s += radixlen; + numtype |= IS_NUMBER_NOT_INT; + /* no digits before the radix means we need digits after it */ + if (isDIGIT(*s)) { + do { + s++; + } while (isDIGIT(*s)); + numtype |= IS_NUMBER_IN_UV; + if (valuep) { + /* integer approximation is valid - it's 0. */ + *valuep = 0; + } + } + else + return 0; + } + else if (*s == 'I' || *s == 'i') { s++; if (*s != 'N' && *s != 'n') return 0; - s++; if (*s != 'I' && *s != 'i') return 0; - s++; if (*s != 'T' && *s != 't') return 0; - s++; if (*s != 'Y' && *s != 'y') return 0; - s++; + s++; if (*s != 'F' && *s != 'f') return 0; + s++; if (*s == 'I' || *s == 'i') { + s++; if (*s != 'N' && *s != 'n') return 0; + s++; if (*s != 'I' && *s != 'i') return 0; + s++; if (*s != 'T' && *s != 't') return 0; + s++; if (*s != 'Y' && *s != 'y') return 0; + s++; + } + sawinf = 1; } - sawinf = 1; + else /* Add test for NaN here. */ + return 0; } - else /* Add test for NaN here. */ - return 0; if (sawinf) { numtype &= IS_NUMBER_NEG; /* Keep track of sign */ @@ -2423,7 +2443,7 @@ Perl_sv_2nv(pTHX_ register SV *sv) sv_upgrade(sv, SVt_PVNV); else sv_upgrade(sv, SVt_NV); -#if defined(USE_LONG_DOUBLE) +#ifdef USE_LONG_DOUBLE DEBUG_c({ STORE_NUMERIC_LOCAL_SET_STANDARD(); PerlIO_printf(Perl_debug_log, @@ -2445,9 +2465,7 @@ Perl_sv_2nv(pTHX_ register SV *sv) if (SvNOKp(sv) && !(SvIOK(sv) || SvPOK(sv))) { SvNOK_on(sv); } - else if (SvIOKp(sv) && - (!SvPOKp(sv) || !grok_number(SvPVX(sv), SvCUR(sv),NULL))) - { + else if (SvIOKp(sv)) { SvNVX(sv) = SvIsUV(sv) ? (NV)SvUVX(sv) : (NV)SvIVX(sv); #ifdef NV_PRESERVES_UV SvNOK_on(sv); diff --git a/t/pragma/locale.t b/t/pragma/locale.t index df6df60509..0926a6ec39 100755 --- a/t/pragma/locale.t +++ b/t/pragma/locale.t @@ -45,7 +45,7 @@ eval { # and mingw32 uses said silly CRT $have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^(cl|gcc)/i; -my $last = $have_setlocale ? 116 : 98; +my $last = $have_setlocale ? &last : &last_without_setlocale; print "1..$last\n"; @@ -235,6 +235,8 @@ check_taint_not 97, $2; check_taint_not 98, $a; +sub last_without_setlocale { 98 } + # I think we've seen quite enough of taint. # Let us do some *real* locale work now, # unless setlocale() is missing (i.e. minitest). @@ -638,7 +640,7 @@ foreach $Locale (@Locale) { my $w = 0; local $SIG{__WARN__} = sub { - print "# @_"; + print "# @_\n"; $w++; }; @@ -665,17 +667,20 @@ foreach $Locale (@Locale) { tryneoalpha($Locale, 110, $e == $c); } - tryneoalpha($Locale, 111, $w == 0); - my $f = "1.23"; + my $g = 2.34; - debug "# 112..114: f = $f, locale = $Locale\n"; + debug "# 111..115: f = $f, g = $g, locale = $Locale\n"; - tryneoalpha($Locale, 112, $f == 1.23); + tryneoalpha($Locale, 111, $f == 1.23); - tryneoalpha($Locale, 113, $f == $x); + tryneoalpha($Locale, 112, $f == $x); - tryneoalpha($Locale, 114, $f == $c); + tryneoalpha($Locale, 113, $f == $c); + + tryneoalpha($Locale, 114, abs(($f + $g) - 3.57) < 0.01); + + tryneoalpha($Locale, 115, $w == 0); } # Does taking lc separately differ from taking @@ -698,7 +703,7 @@ foreach $Locale (@Locale) { my $y = "aa"; my $z = "AB"; - tryneoalpha($Locale, 115, + tryneoalpha($Locale, 116, lcA($x, $y) == 1 && lcB($x, $y) == 1 || lcA($x, $z) == 0 && lcB($x, $z) == 0); } @@ -711,7 +716,7 @@ foreach $Locale (@Locale) { # utf8 and locales do not mix. debug "# skipping UTF-8 locale '$Locale'\n"; push @utf8locale, $Locale; - $utf8skip{116}++; + $utf8skip{117}++; } else { use locale; use locale; @@ -728,9 +733,9 @@ foreach $Locale (@Locale) { next unless lc $y eq $x; push @f, $x unless $x =~ /$y/i && $y =~ /$x/i; } - tryneoalpha($Locale, 116, @f == 0); + tryneoalpha($Locale, 117, @f == 0); if (@f) { - print "# failed 116 locale '$Locale' characters @f\n" + print "# failed 117 locale '$Locale' characters @f\n" } } } @@ -738,7 +743,7 @@ foreach $Locale (@Locale) { # Recount the errors. -foreach (99..$last) { +foreach (&last_without_setlocale()+1..$last) { if ($Problem{$_} || !defined $Okay{$_} || !@{$Okay{$_}}) { if ($_ == 102) { print "# The failure of test 102 is not necessarily fatal.\n"; @@ -829,4 +834,6 @@ if ($didwarn) { } } +sub last { 117 } + # eof -- 2.34.1