From e62cc96aadf7217b976ed2782e6fe409b2646a3b Mon Sep 17 00:00:00 2001 From: Yves Orton Date: Sun, 8 Oct 2006 22:14:24 +0200 Subject: [PATCH] Re: [perl #40468] Not OK: perl 5.9.4 +patchaperlup: on i686-linux-64int 2.6.17-2-k7 (UNINSTALLED) Message-ID: <9b18b3110610081114g11dabafaw860181598ab54bd6@mail.gmail.com> p4raw-id: //depot/perl@28967 --- hv.c | 211 +++++++++++++++++++++++++++++++------------------------------ regcomp.c | 28 ++++---- t/op/pat.t | 47 ++++++++++++-- 3 files changed, 162 insertions(+), 124 deletions(-) diff --git a/hv.c b/hv.c index 8552cd2..1432077 100644 --- a/hv.c +++ b/hv.c @@ -451,9 +451,10 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (SvMAGICAL(hv)) { if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) { MAGIC *regdata = NULL; - if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv) - || (regdata = mg_find((SV*)hv, PERL_MAGIC_regdata_names))) { - + if (( regdata = mg_find((SV*)hv, PERL_MAGIC_regdata_names)) || + mg_find((SV*)hv, PERL_MAGIC_tied) || + SvGMAGICAL((SV*)hv)) + { /* XXX should be able to skimp on the HE/HEK here when HV_FETCH_JUST_SV is true. */ if (!keysv) { @@ -1932,7 +1933,7 @@ Perl_hv_iterinit(pTHX_ HV *hv) } else { hv_auxinit(hv); } - if (SvMAGICAL(hv) && SvRMAGICAL(hv)) { + if ( SvRMAGICAL(hv) ) { MAGIC *mg = mg_find((SV*)hv, PERL_MAGIC_regdata_names); if ( mg ) { if (PL_curpm) { @@ -2109,114 +2110,114 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) iter = HvAUX(hv); oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */ - if (SvMAGICAL(hv) && SvRMAGICAL(hv) && - (mg = mg_find((SV*)hv, PERL_MAGIC_regdata_names))) - { - SV * key; - SV *val = NULL; - REGEXP * rx; - if (!PL_curpm) - return NULL; - rx = PM_GETRE(PL_curpm); - if (rx && rx->paren_names) { - hv = rx->paren_names; - } else { - return NULL; - } + if (SvMAGICAL(hv) && SvRMAGICAL(hv)) { + if ( ( mg = mg_find((SV*)hv, PERL_MAGIC_regdata_names) ) ) { + SV * key; + SV *val = NULL; + REGEXP * rx; + if (!PL_curpm) + return NULL; + rx = PM_GETRE(PL_curpm); + if (rx && rx->paren_names) { + hv = rx->paren_names; + } else { + return NULL; + } - key = sv_newmortal(); - if (entry) { - sv_setsv(key, HeSVKEY_force(entry)); - SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ - } - else { - char *k; - HEK *hek; - - /* one HE per MAGICAL hash */ - iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */ - Zero(entry, 1, HE); - Newxz(k, HEK_BASESIZE + sizeof(SV*), char); - hek = (HEK*)k; - HeKEY_hek(entry) = hek; - HeKLEN(entry) = HEf_SVKEY; - } - { - while (!val) { - HE *temphe = hv_iternext_flags(hv,flags); - if (temphe) { - IV i; - IV parno = 0; - SV* sv_dat = HeVAL(temphe); - I32 *nums = (I32*)SvPVX(sv_dat); - for ( i = 0; i < SvIVX(sv_dat); i++ ) { - if ((I32)(rx->lastcloseparen) >= nums[i] && - rx->startp[nums[i]] != -1 && - rx->endp[nums[i]] != -1) - { - parno = nums[i]; - break; + key = sv_newmortal(); + if (entry) { + sv_setsv(key, HeSVKEY_force(entry)); + SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ + } + else { + char *k; + HEK *hek; + + /* one HE per MAGICAL hash */ + iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */ + Zero(entry, 1, HE); + Newxz(k, HEK_BASESIZE + sizeof(SV*), char); + hek = (HEK*)k; + HeKEY_hek(entry) = hek; + HeKLEN(entry) = HEf_SVKEY; + } + { + while (!val) { + HE *temphe = hv_iternext_flags(hv,flags); + if (temphe) { + IV i; + IV parno = 0; + SV* sv_dat = HeVAL(temphe); + I32 *nums = (I32*)SvPVX(sv_dat); + for ( i = 0; i < SvIVX(sv_dat); i++ ) { + if ((I32)(rx->lastcloseparen) >= nums[i] && + rx->startp[nums[i]] != -1 && + rx->endp[nums[i]] != -1) + { + parno = nums[i]; + break; + } + } + if (parno) { + GV *gv_paren; + STRLEN len; + SV *sv = sv_newmortal(); + const char* pvkey = HePV(temphe, len); + + Perl_sv_setpvf(aTHX_ sv, "%"IVdf,(IV)parno); + gv_paren = Perl_gv_fetchsv(aTHX_ sv, GV_ADD, SVt_PVGV); + Perl_sv_setpvn(aTHX_ key, pvkey, len); + val = GvSVn(gv_paren); } + } else { + break; } - if (parno) { - GV *gv_paren; - STRLEN len; - SV *sv = sv_newmortal(); - const char* pvkey = HePV(temphe, len); - - Perl_sv_setpvf(aTHX_ sv, "%"IVdf,(IV)parno); - gv_paren = Perl_gv_fetchsv(aTHX_ sv, GV_ADD, SVt_PVGV); - Perl_sv_setpvn(aTHX_ key, pvkey, len); - val = GvSVn(gv_paren); - } - } else { - break; } } + if (val && SvOK(key)) { + /* force key to stay around until next time */ + HeSVKEY_set(entry, SvREFCNT_inc_simple_NN(key)); + HeVAL(entry) = SvREFCNT_inc_simple_NN(val); + return entry; /* beware, hent_val is not set */ + } + if (HeVAL(entry)) + SvREFCNT_dec(HeVAL(entry)); + Safefree(HeKEY_hek(entry)); + del_HE(entry); + iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ + return NULL; } - if (val && SvOK(key)) { - /* force key to stay around until next time */ - HeSVKEY_set(entry, SvREFCNT_inc_simple_NN(key)); - HeVAL(entry) = SvREFCNT_inc_simple_NN(val); - return entry; /* beware, hent_val is not set */ + else if ( ( mg = mg_find((SV*)hv, PERL_MAGIC_tied) ) ) { + SV * const key = sv_newmortal(); + if (entry) { + sv_setsv(key, HeSVKEY_force(entry)); + SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ + } + else { + char *k; + HEK *hek; + + /* one HE per MAGICAL hash */ + iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */ + Zero(entry, 1, HE); + Newxz(k, HEK_BASESIZE + sizeof(SV*), char); + hek = (HEK*)k; + HeKEY_hek(entry) = hek; + HeKLEN(entry) = HEf_SVKEY; + } + magic_nextpack((SV*) hv,mg,key); + if (SvOK(key)) { + /* force key to stay around until next time */ + HeSVKEY_set(entry, SvREFCNT_inc_simple_NN(key)); + return entry; /* beware, hent_val is not set */ + } + if (HeVAL(entry)) + SvREFCNT_dec(HeVAL(entry)); + Safefree(HeKEY_hek(entry)); + del_HE(entry); + iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ + return NULL; } - if (HeVAL(entry)) - SvREFCNT_dec(HeVAL(entry)); - Safefree(HeKEY_hek(entry)); - del_HE(entry); - iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ - return NULL; - - } else if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) { - SV * const key = sv_newmortal(); - if (entry) { - sv_setsv(key, HeSVKEY_force(entry)); - SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ - } - else { - char *k; - HEK *hek; - - /* one HE per MAGICAL hash */ - iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */ - Zero(entry, 1, HE); - Newxz(k, HEK_BASESIZE + sizeof(SV*), char); - hek = (HEK*)k; - HeKEY_hek(entry) = hek; - HeKLEN(entry) = HEf_SVKEY; - } - magic_nextpack((SV*) hv,mg,key); - if (SvOK(key)) { - /* force key to stay around until next time */ - HeSVKEY_set(entry, SvREFCNT_inc_simple_NN(key)); - return entry; /* beware, hent_val is not set */ - } - if (HeVAL(entry)) - SvREFCNT_dec(HeVAL(entry)); - Safefree(HeKEY_hek(entry)); - del_HE(entry); - iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ - return NULL; } #if defined(DYNAMIC_ENV_FETCH) && !defined(__riscos__) /* set up %ENV for iteration */ if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) { diff --git a/regcomp.c b/regcomp.c index ca5830f..71c9133 100644 --- a/regcomp.c +++ b/regcomp.c @@ -1759,7 +1759,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs char *str=NULL; #ifdef DEBUGGING - regnode *optimize; + regnode *optimize = NULL; U32 mjd_offset = 0; U32 mjd_nodelen = 0; #endif @@ -1930,9 +1930,9 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs as we won't use them - (which resources?) dmq */ } /* needed for dumping*/ - DEBUG_r({ + DEBUG_r(if (optimize) { regnode *opt = convert; - while (++opt' ? '<' : paren); if (SIZE_ONLY) { - SV *svname= Perl_newSVpvf(aTHX_ "%.*s", - (int)(RExC_parse - name_start), name_start); - HE *he_str; - SV *sv_dat; - + SV *svname= Perl_newSVpvf(aTHX_ "%.*s", + (int)(RExC_parse - name_start), name_start); + HE *he_str; + SV *sv_dat = NULL; + if (!RExC_paren_names) { RExC_paren_names= newHV(); sv_2mortal((SV*)RExC_paren_names); } he_str = hv_fetch_ent( RExC_paren_names, svname, 1, 0 ); - if ( he_str ) { + if ( he_str ) sv_dat = HeVAL(he_str); - } else { + if ( ! sv_dat ) { /* croak baby croak */ - } - if (SvPOK(sv_dat)) { + Perl_croak(aTHX_ + "panic: paren_name hash element allocation failed"); + } else if ( SvPOK(sv_dat) ) { IV count=SvIV(sv_dat); I32 *pv=(I32*)SvGROW(sv_dat,SvCUR(sv_dat)+sizeof(I32)+1); SvCUR_set(sv_dat,SvCUR(sv_dat)+sizeof(I32)); @@ -4482,7 +4483,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) sv_setpvn(sv_dat, (char *)&(RExC_npar), sizeof(I32)); SvIOK_on(sv_dat); SvIVX(sv_dat)= 1; - } + } + /*sv_dump(sv_dat);*/ } nextchar(pRExC_state); diff --git a/t/op/pat.t b/t/op/pat.t index e1ac167..465757d 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -3665,20 +3665,55 @@ SKIP:{ $s=~s/(?'digits'\d+)\k'digits'/$+{digits}/; ok($s eq '123456','Named capture (single quotes) s///'); } +sub iseq($$;$) { + my ( $got, $expect, $name)=@_; + + $_=defined($_) ? "'$_'" : "undef" + for $got, $expect; + + my $ok= $got eq $expect; + + printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name||'unnamed'; + + printf "# Failed test at line %d\n". + "# expected: %s\n". + "# result: %s\n", + (caller)[2], $expect, $got + unless $ok; + + $test++; + return $ok; +} { my $s='foo bar baz'; - my (@k,@v,$count); + my (@k,@v,@fetch,$res); + my $count= 0; + my @names=qw($+{A} $+{B} $+{C}); if ($s=~/(?foo)\s+(?bar)?\s+(?baz)/) { while (my ($k,$v)=each(%+)) { $count++; } @k=sort keys(%+); @v=sort values(%+); + $res=1; + push @fetch, + [ "$+{A}", "$1" ], + [ "$+{B}", "$2" ], + [ "$+{C}", "$3" ], + ; + } + foreach (0..2) { + if ($fetch[$_]) { + iseq($fetch[$_][0],$fetch[$_][1],$names[$_]); + } else { + ok(0, $names[$_]); + } } - ok($count==3,"Got 3 keys in %+ via each ($count)"); - ok(@k == 3, 'Got 3 keys in %+ via keys'); - ok("@k" eq "A B C", "Got expected keys"); - ok("@v" eq "bar baz foo", "Got expected values"); + iseq($res,1,"$s~=/(?foo)\s+(?bar)?\s+(?baz)/"); + iseq($count,3,"Got 3 keys in %+ via each"); + iseq(0+@k, 3, 'Got 3 keys in %+ via keys'); + iseq("@k","A B C", "Got expected keys"); + iseq("@v","bar baz foo", "Got expected values"); } @@ -3796,5 +3831,5 @@ ok((q(a)x 100) =~ /^(??{'(.)'x 100})/, or print "# Unexpected outcome: should pass or crash perl\n"; # Don't forget to update this! -BEGIN{print "1..1270\n"}; +BEGIN{print "1..1274\n"}; -- 2.7.4