More lexical patches merged by Dave Mitchell.

18048   PL_curpad == AvARRAY(PL_comppad) always
18142   Re: threads and Win2000 (ithread cloning prob fix)
18220   allow evals to see the full lexical scope
18307   lexical "my" variables not visible in debugger "x" command
18528   [PATCH pp_ctl.c] silence warning
18223   SvFAKE lexicals in scope for all of the sub
18302   Proper fix for CvOUTSIDE weak refcounting
18571   Re: difference between my and our before introduction

p4raw-id: //depot/maint-5.8/perl@18791

1 files changed, 25 insertions, 24 deletions

diff --git a/op.c b/op.c
index c622a1f84f..ba94fd6655 100644
--- a/op.c
+++ b/op.c
@@ -3857,12 +3857,20 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
     return o;
 }
 
+/*
+=for apidoc cv_undef
+
+Clear out all the active components of a CV. This can happen either
+by an explicit C<undef &foo>, or by the reference count going to zero.
+In the former case, we keep the CvOUTSIDE pointer, so that any anonymous
+children can still follow the full lexical scope chain.
+
+=cut
+*/
+
 void
 Perl_cv_undef(pTHX_ CV *cv)
 {
-    CV *outsidecv;
-    CV *freecv = Nullcv;
-
 #ifdef USE_5005THREADS
     if (CvMUTEXP(cv)) {
 	MUTEX_DESTROY(CvMUTEXP(cv));
@@ -3889,7 +3897,7 @@ Perl_cv_undef(pTHX_ CV *cv)
 #endif /* USE_5005THREADS */
 	ENTER;
 
-	PAD_SAVE_SETNULLPAD;
+	PAD_SAVE_SETNULLPAD();
 
 	op_free(CvROOT(cv));
 	CvROOT(cv) = Nullop;
@@ -3897,26 +3905,24 @@ Perl_cv_undef(pTHX_ CV *cv)
     }
     SvPOK_off((SV*)cv);		/* forget prototype */
     CvGV(cv) = Nullgv;
-    outsidecv = 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))
-        freecv = outsidecv;
-    CvOUTSIDE(cv) = Nullcv;
+
+    pad_undef(cv);
+
+    /* remove CvOUTSIDE unless this is an undef rather than a free */
+    if (!SvREFCNT(cv) && CvOUTSIDE(cv)) {
+	if (!CvWEAKOUTSIDE(cv))
+	    SvREFCNT_dec(CvOUTSIDE(cv));
+	CvOUTSIDE(cv) = Nullcv;
+    }
     if (CvCONST(cv)) {
 	SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr);
 	CvCONST_off(cv);
     }
-    pad_undef(cv, outsidecv);
-    if (freecv)
-	SvREFCNT_dec(freecv);
     if (CvXSUB(cv)) {
         CvXSUB(cv) = 0;
     }
-    CvFLAGS(cv) = 0;
+    /* delete all flags except WEAKOUTSIDE */
+    CvFLAGS(cv) &= CVf_WEAKOUTSIDE;
 }
 
 void
@@ -4203,9 +4209,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    SAVEFREESV(PL_compcv);
 	    goto done;
 	}
+	/* transfer PL_compcv to cv */
 	cv_undef(cv);
 	CvFLAGS(cv) = CvFLAGS(PL_compcv);
 	CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
+	CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(PL_compcv);
 	CvOUTSIDE(PL_compcv) = 0;
 	CvPADLIST(cv) = CvPADLIST(PL_compcv);
 	CvPADLIST(PL_compcv) = 0;
@@ -4283,13 +4291,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    CvCONST_on(cv);
     }
 
-    /* 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);