With Damian's approval synchronize damian's modules'

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index cca2310..64914ea 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2872,11 +2872,8 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                }
            }
        }
-       if (!del) {
-           if (j >= rlen)
-               j = rlen - 1;
-           else
-               cPVOPo->op_pv = (char*)Renew(tbl, 0x101+rlen-j, short);
+       if (!del && rlen >= j) {
+           cPVOPo->op_pv = (char*)Renew(tbl, 0x101+rlen-j, short);
            tbl[0x100] = rlen - j;
            for (i=0; i < rlen - j; i++)
                tbl[0x101+i] = r[j+i];
@@ -4158,14 +4155,19 @@ Perl_cv_undef(pTHX_ CV *cv)
        SAVEVPTR(PL_curpad);
        PL_curpad = 0;
 
-       if (!CvCLONED(cv))
-           op_free(CvROOT(cv));
+       op_free(CvROOT(cv));
        CvROOT(cv) = Nullop;
        LEAVE;
     }
     SvPOK_off((SV*)cv);                /* forget prototype */
     CvGV(cv) = Nullgv;
-    SvREFCNT_dec(CvOUTSIDE(cv));
+    /* Since closure prototypes have the same lifetime as the containing
+     * CV, they don't hold a refcount on the outside CV.  This avoids
+     * the refcount loop between the outer CV (which keeps a refcount to
+     * the closure prototype in the pad entry for pp_anoncode()) and the
+     * closure prototype, and the ensuing memory leak.  --GSAR */
+    if (!CvANON(cv) || CvCLONED(cv))
+       SvREFCNT_dec(CvOUTSIDE(cv));
     CvOUTSIDE(cv) = Nullcv;
     if (CvCONST(cv)) {
        SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
@@ -4279,7 +4281,7 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     CvFILE(cv)         = CvFILE(proto);
     CvGV(cv)           = CvGV(proto);
     CvSTASH(cv)                = CvSTASH(proto);
-    CvROOT(cv)         = CvROOT(proto);
+    CvROOT(cv)         = OpREFCNT_inc(CvROOT(proto));
     CvSTART(cv)                = CvSTART(proto);
     if (outside)
        CvOUTSIDE(cv)   = (CV*)SvREFCNT_inc(outside);
@@ -4675,8 +4677,30 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        CvOUTSIDE(PL_compcv) = 0;
        CvPADLIST(cv) = CvPADLIST(PL_compcv);
        CvPADLIST(PL_compcv) = 0;
-       if (SvREFCNT(PL_compcv) > 1) /* XXX Make closures transit through stub. */
-           CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc((SV*)cv);
+       /* inner references to PL_compcv must be fixed up ... */
+       {
+           AV *padlist = CvPADLIST(cv);
+           AV *comppad_name = (AV*)AvARRAY(padlist)[0];
+           AV *comppad = (AV*)AvARRAY(padlist)[1];
+           SV **namepad = AvARRAY(comppad_name);
+           SV **curpad = AvARRAY(comppad);
+           for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
+               SV *namesv = namepad[ix];
+               if (namesv && namesv != &PL_sv_undef
+                   && *SvPVX(namesv) == '&')
+               {
+                   CV *innercv = (CV*)curpad[ix];
+                   if (CvOUTSIDE(innercv) == PL_compcv) {
+                       CvOUTSIDE(innercv) = cv;
+                       if (!CvANON(innercv) || CvCLONED(innercv)) {
+                           (void)SvREFCNT_inc(cv);
+                           SvREFCNT_dec(PL_compcv);
+                       }
+                   }
+               }
+           }
+       }
+       /* ... before we throw it away */
        SvREFCNT_dec(PL_compcv);
     }
     else {
@@ -4779,6 +4803,13 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
     }
 
+    /* If a potential closure prototype, don't keep a refcount on outer CV.
+     * This is okay as the lifetime of the prototype is tied to the
+     * lifetime of the outer CV.  Avoids memory leak due to reference
+     * loop. --GSAR */
+    if (!name)
+       SvREFCNT_dec(CvOUTSIDE(cv));
+
     if (name || aname) {
        char *s;
        char *tname = (name ? name : aname);