diff options
| -rw-r--r-- | Changes | 138 | ||||
| -rwxr-xr-x | Configure | 9 | ||||
| -rw-r--r-- | embed.h | 4 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | patchlevel.h | 2 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | sv.c | 74 | ||||
| -rwxr-xr-x | t/pragma/locale.t | 33 | ||||
| -rw-r--r-- | util.c | 2 |
9 files changed, 215 insertions, 49 deletions
@@ -31,6 +31,144 @@ or any other branch. Version v5.7.1 Development release working toward v5.8 -------------- ____________________________________________________________________________ +[ 10495] By: jhi on 2001/06/10 10:55:34 + Log: Subject: Re: pragma/locale.t #107 + From: Hugo <hv@crypt.compulink.co.uk> + Date: Sun, 10 Jun 2001 11:23:30 +0100 + Message-Id: <200106101023.LAA32085@crypt.compulink.co.uk> + + Encapsulate the scan of the decimal radix separator. + Branch: perl + ! embed.h embed.pl proto.h sv.c +____________________________________________________________________________ +[ 10494] By: jhi on 2001/06/10 03:00:17 + Log: 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 + From: Nicholas Clark <nick@ccl4.org> + Date: Sat, 9 Jun 2001 22:37:36 +0100 + Message-ID: <20010609223735.Y76396@plum.flirble.org> + Branch: perl + ! sv.c t/pragma/locale.t +____________________________________________________________________________ +[ 10493] By: jhi on 2001/06/10 01:25:23 + Log: Metaconfig unit change for #10492. + Branch: metaconfig/U/perl + ! Extensions.U +____________________________________________________________________________ +[ 10492] By: jhi on 2001/06/10 01:23:59 + Log: Subject: [PATCH] Don't build Thread.pm if USEITHREADS + From: Artur Bergman <artur@contiller.se> + Date: Sat, 09 Jun 2001 21:03:51 +0200 + Message-ID: <B7483FB6.1398%artur@contiller.se> + Branch: perl + ! Configure +____________________________________________________________________________ +[ 10491] By: jhi on 2001/06/10 01:15:40 + Log: Integrate perlio. + Branch: perl + !> perlsfio.h +____________________________________________________________________________ +[ 10490] By: jhi on 2001/06/10 01:08:26 + Log: Do locale specific separator if only in locale. + Branch: perl + ! util.c +____________________________________________________________________________ +[ 10489] By: nick on 2001/06/09 19:13:25 + Log: Make XS/Typemap compile (but fail) with sfio + Branch: perlio + ! perlsfio.h +____________________________________________________________________________ +[ 10488] By: nick on 2001/06/09 19:12:51 + Log: Re-integrate mainline + Branch: perlio + !> embed.h embed.pl embedvar.h intrpvar.h perl.h perlapi.h + !> proto.h sv.c util.c +____________________________________________________________________________ +[ 10487] By: nick on 2001/06/09 16:26:29 + Log: Integrate mainline + Branch: perlio + !> (integrate 31 files) +____________________________________________________________________________ +[ 10486] By: jhi on 2001/06/09 16:11:51 + Log: Subject: [PATCH] New attempt to clone callack + From: Artur Bergman <artur@contiller.se> + Date: Thu, 07 Jun 2001 11:52:16 +0200 + Message-ID: <B7451B6F.12B7%artur@contiller.se> + Branch: perl + ! embedvar.h intrpvar.h perlapi.h sv.c +____________________________________________________________________________ +[ 10485] By: jhi on 2001/06/09 15:23:52 + Log: Numeric conversion tweaks suggested by Hugo and Nicholas. + Branch: perl + ! embed.h embed.pl perl.h proto.h sv.c util.c +____________________________________________________________________________ +[ 10484] By: jhi on 2001/06/09 14:47:25 + Log: Subject: Re: pragma/locale.t #107 + From: Nicholas Clark <nick@ccl4.org> + Date: Sat, 9 Jun 2001 16:26:10 +0100 + Message-ID: <20010609162609.V76396@plum.flirble.org> + + A missing NVification. + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 10483] By: jhi on 2001/06/08 19:40:32 + Log: Redo the #10482, there already was a test script for formats. + Branch: perl + - t/io/format.t + ! MANIFEST t/op/write.t +____________________________________________________________________________ +[ 10482] By: jhi on 2001/06/08 19:34:45 + Log: Twisted format testing, from Merijn. + Branch: perl + + t/io/format.t + ! MANIFEST +____________________________________________________________________________ +[ 10481] By: jhi on 2001/06/08 19:21:56 + Log: More \p{In...} testing, combined with \N{...}. + Branch: perl + ! lib/utf8_heavy.pl t/op/pat.t +____________________________________________________________________________ +[ 10480] By: jhi on 2001/06/08 14:16:06 + Log: Metaconfig changes for #10479. + Branch: metaconfig + ! U/Glossary.patch + Branch: metaconfig/U/perl + ! d_modfl.U +____________________________________________________________________________ +[ 10479] By: jhi on 2001/06/08 14:15:32 + Log: Be inspired more by Hugo-- introduce HAS_MODFL_POW32_BUG. + Branch: perl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH configure.com epoc/config.sh pp.c uconfig.h + ! uconfig.sh vos/config.alpha.def vos/config.ga.def + ! win32/config.bc win32/config.gc win32/config.vc +____________________________________________________________________________ +[ 10478] By: jhi on 2001/06/08 12:20:41 + Log: Subject: Re: [PATCH perl@10439] fix old $^S description in perlvms.pod + From: "Craig A. Berry" <craigberry@mac.com> + Date: Thu, 7 Jun 2001 14:27:20 -0500 + Message-Id: <a05100e01b7458075db7d@[172.16.52.1]> + Branch: perl + ! vms/perlvms.pod +____________________________________________________________________________ +[ 10477] By: jhi on 2001/06/08 12:19:00 + Log: Subject: [PATCH] Unresolved symbol in ext/re/re.xs + From: Gisle Aas <gisle@ActiveState.com> + Date: 07 Jun 2001 17:04:29 -0700 + Message-ID: <lrae3jsupe.fsf@caliper.ActiveState.com> + Branch: perl + ! ext/re/re.xs +____________________________________________________________________________ +[ 10476] By: jhi on 2001/06/08 01:35:42 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ [ 10475] By: jhi on 2001/06/08 00:53:45 Log: Regen Glossary et alia. Branch: perl @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Fri Jun 8 18:06:31 EET DST 2001 [metaconfig 3.0 PL70] +# Generated on Sun Jun 10 05:21:37 EET DST 2001 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.org) cat >c1$$ <<EOF @@ -15985,8 +15985,11 @@ for xxx in $known_extensions ; do esac ;; Thread|thread) - case "$usethreads" in - true|$define|y) avail_ext="$avail_ext $xxx" ;; + case "$usethreads" in + true|$define|y) + case "$useithreads" in + $undef|false|[nN]*) avail_ext="$avail_ext $xxx" ;; + esac esac ;; IPC/SysV|ipc/sysv) @@ -1115,6 +1115,7 @@ #define gv_share S_gv_share # endif #define grok_number S_grok_number +#define grok_numeric_radix S_grok_numeric_radix #endif #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) #define check_uni S_check_uni @@ -2609,6 +2610,7 @@ #define gv_share(a) S_gv_share(aTHX_ a) # endif #define grok_number(a,b,c) S_grok_number(aTHX_ a,b,c) +#define grok_numeric_radix(a,b) S_grok_numeric_radix(aTHX_ a,b) #endif #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) #define check_uni() S_check_uni(aTHX) @@ -5083,6 +5085,8 @@ # endif #define S_grok_number CPerlObj::S_grok_number #define grok_number S_grok_number +#define S_grok_numeric_radix CPerlObj::S_grok_numeric_radix +#define grok_numeric_radix S_grok_numeric_radix #endif #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) #define S_check_uni CPerlObj::S_check_uni @@ -2522,6 +2522,7 @@ s |I32 |expect_number |char** pattern s |SV* |gv_share |SV *sv # endif s |int |grok_number |const char *pv|STRLEN len|UV *valuep +s |bool |grok_numeric_radix|const char **sp|const char *send #endif #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) diff --git a/patchlevel.h b/patchlevel.h index 47ccbe720c..8dcc7fece8 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -70,7 +70,7 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL - ,"DEVEL10475" + ,"DEVEL10495" ,NULL }; @@ -1246,6 +1246,7 @@ STATIC I32 S_expect_number(pTHX_ char** pattern); STATIC SV* S_gv_share(pTHX_ SV *sv); # endif STATIC int S_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep); +STATIC int S_grok_numeric_radix(pTHX_ const char **sp, const char *send); #endif #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) @@ -1494,6 +1494,30 @@ S_not_a_number(pTHX_ SV *sv) #define IS_NUMBER_NEG 0x08 /* leading minus sign */ #define IS_NUMBER_INFINITY 0x10 /* this is big */ +static bool +S_grok_numeric_radix(pTHX_ const char **sp, const char *send) +{ +#ifdef USE_LOCALE_NUMERIC + if (PL_numeric_radix_sv && IN_LOCALE) { + STRLEN len; + char* radix = SvPV(PL_numeric_radix_sv, len); + if (*sp + len <= send && memEQ(*sp, radix, len)) { + *sp += len; + return TRUE; + } + } + /* always try "." if numeric radix didn't match because + * we may have data from different locales mixed */ +#endif + if (*sp < send && **sp == '.') { + ++*sp; + return TRUE; + } + return FALSE; +} + +#define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) + static int S_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) { @@ -1503,9 +1527,6 @@ S_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) const char max_mod_10 = UV_MAX % 10 + '0'; int numtype = 0; int sawinf = 0; - char* radix = "."; - STRLEN radixlen = 1; - while (isSPACE(*s)) s++; @@ -1516,11 +1537,6 @@ S_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) else if (*s == '+') s++; -#ifdef USE_LOCALE_NUMERIC - if (PL_numeric_radix_sv && IN_LOCALE) - radix = SvPV(PL_numeric_radix_sv, radixlen); -#endif - /* next must be digit or the radix separator or beginning of infinity */ if (isDIGIT(*s)) { /* UVs are at least 32 bits, so the first 9 decimal digits cannot @@ -1589,32 +1605,30 @@ S_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) *valuep = value; skip_value: - if (s + radixlen <= send && memEQ(s, radix, radixlen)) { - s += radixlen; + if (GROK_NUMERIC_RADIX(&s, send)) { 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 (GROK_NUMERIC_RADIX(&s, send)) { + 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 != 'N' && *s != 'n') return 0; s++; if (*s != 'F' && *s != 'f') return 0; s++; if (*s == 'I' || *s == 'i') { s++; if (*s != 'N' && *s != 'n') return 0; @@ -2423,7 +2437,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 +2459,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 @@ -4083,7 +4083,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value) I32 offcount; /* number of digits in least significant part */ #ifdef USE_LOCALE_NUMERIC - if (PL_numeric_radix_sv) + if (PL_numeric_radix_sv && IN_LOCALE) point = SvPV(PL_numeric_radix_sv, pointlen); #endif |