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

3 files changed, 162 insertions, 124 deletions

diff --git a/hv.c b/hv.c
index 8552cd2abc..14320773b0 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 ca5830f875..71c9133225 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<optimize) {
+            while ( ++opt < optimize) {
                 Set_Node_Offset_Length(opt,0,0);
             }
             /* 
@@ -4456,22 +4456,23 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
 		        vFAIL2("Sequence (?%c... not terminated",
 		            paren=='>' ? '<' : 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 e1ac167f10..465757df1d 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=~/(?<A>foo)\s+(?<B>bar)?\s+(?<C>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~=/(?<A>foo)\s+(?<B>bar)?\s+(?<C>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"};