From: Brandon Black <blblack@gmail.com>
Date: Tue, 8 May 2007 15:15:29 +0000 (-0500)
Subject: Re: mro c3 infinite recursion problem. Attemp to free unreferenced scalar
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1dcae2832b009ee3632057559967f11b1052d943;p=p5sagit%2Fp5-mst-13.2.git

Re: mro c3 infinite recursion problem. Attemp to free unreferenced scalar
From: "Brandon Black" <blblack@gmail.com>
Message-ID: <84621a60705081315hca3885duc14b8c3e44080853@mail.gmail.com>

p4raw-id: //depot/perl@31174
---

diff --git a/mro.c b/mro.c
index f7b3668..1e14bd1 100644
--- a/mro.c
+++ b/mro.c
@@ -219,9 +219,6 @@ Perl_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level)
 
     /* not in cache, make a new one */
 
-    retval = newAV();
-    av_push(retval, newSVpvn(stashname, stashname_len)); /* us first */
-
     gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
     isa = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
 
@@ -257,9 +254,9 @@ Perl_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level)
             else {
                 isa_lin = mro_get_linear_isa_c3(isa_item_stash, level + 1); /* recursion */
             }
-            av_push(seqs, (SV*)isa_lin);
+            av_push(seqs, SvREFCNT_inc_simple_NN((SV*)isa_lin));
         }
-        av_push(seqs, (SV*)isa);
+        av_push(seqs, SvREFCNT_inc_simple_NN((SV*)isa));
 
         /* This builds "heads", which as an array of integer array
            indices, one per seq, which point at the virtual "head"
@@ -292,6 +289,10 @@ Perl_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level)
             }
         }
 
+        /* Initialize retval to build the return value in */
+        retval = newAV();
+        av_push(retval, newSVpvn(stashname, stashname_len)); /* us first */
+
         /* This loop won't terminate until we either finish building
            the MRO, or get an exception. */
         while(1) {
@@ -335,6 +336,7 @@ Perl_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level)
 
                     const int new_head = ++heads[s];
                     if(new_head > AvFILLp(seq)) {
+                        SvREFCNT_dec(avptr[s]);
                         avptr[s] = NULL;
                     }
                     else {
@@ -363,10 +365,6 @@ Perl_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level)
                hierarchy is not C3-incompatible */
             if(!winner) {
                 /* we have to do some cleanup before we croak */
-                SV** svp = AvARRAY(seqs);
-                items = AvFILLp(seqs) + 1;
-                while (items--)
-                    *svp++ = NULL;
 
                 SvREFCNT_dec(retval);
                 Safefree(heads);
@@ -376,6 +374,11 @@ Perl_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level)
             }
         }
     }
+    else { /* @ISA was undefined or empty */
+        /* build a retval containing only ourselves */
+        retval = newAV();
+        av_push(retval, newSVpvn(stashname, stashname_len));
+    }
 
     /* we don't want anyone modifying the cache entry but us,
        and we do so by replacing it completely */
diff --git a/t/mro/recursion_c3.t b/t/mro/recursion_c3.t
index 5429315..4030cfc 100644
--- a/t/mro/recursion_c3.t
+++ b/t/mro/recursion_c3.t
@@ -26,26 +26,37 @@ into an infinite loop
 # initial setup, everything sane
 {
     package K;
+    use mro 'c3';
     our @ISA = qw/J I/;
     package J;
+    use mro 'c3';
     our @ISA = qw/F/;
     package I;
+    use mro 'c3';
     our @ISA = qw/H F/;
     package H;
+    use mro 'c3';
     our @ISA = qw/G/;
     package G;
+    use mro 'c3';
     our @ISA = qw/D/;
     package F;
+    use mro 'c3';
     our @ISA = qw/E/;
     package E;
+    use mro 'c3';
     our @ISA = qw/D/;
     package D;
+    use mro 'c3';
     our @ISA = qw/A B C/;
     package C;
+    use mro 'c3';
     our @ISA = qw//;
     package B;
+    use mro 'c3';
     our @ISA = qw//;
     package A;
+    use mro 'c3';
     our @ISA = qw//;
 }