diff options
| -rw-r--r-- | cv.h | 61 | ||||
| -rw-r--r-- | dump.c | 1 | ||||
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | ext/B/B/Deparse.pm | 13 | ||||
| -rw-r--r-- | ext/B/defsubs_h.PL | 2 | ||||
| -rw-r--r-- | ext/Devel/Peek/Peek.t | 4 | ||||
| -rw-r--r-- | op.c | 39 | ||||
| -rw-r--r-- | pad.c | 69 | ||||
| -rw-r--r-- | pod/perlapi.pod | 12 | ||||
| -rw-r--r-- | pod/perlintern.pod | 67 | ||||
| -rw-r--r-- | pp_ctl.c | 2 | ||||
| -rw-r--r-- | sv.c | 11 | ||||
| -rwxr-xr-x | t/op/closure.t | 59 |
13 files changed, 276 insertions, 66 deletions
@@ -81,6 +81,8 @@ Returns the stash of the CV. #define CVf_LOCKED 0x0080 /* CV locks itself or first arg on entry */ #define CVf_LVALUE 0x0100 /* CV return value can be used as lvalue */ #define CVf_CONST 0x0200 /* inlinable sub */ +#define CVf_WEAKOUTSIDE 0x0400 /* CvOUTSIDE isn't ref counted */ + /* This symbol for optimised communication between toke.c and op.c: */ #define CVf_BUILTIN_ATTRS (CVf_METHOD|CVf_LOCKED|CVf_LVALUE) @@ -135,3 +137,62 @@ Returns the stash of the CV. #define CvCONST_on(cv) (CvFLAGS(cv) |= CVf_CONST) #define CvCONST_off(cv) (CvFLAGS(cv) &= ~CVf_CONST) +#define CvWEAKOUTSIDE(cv) (CvFLAGS(cv) & CVf_WEAKOUTSIDE) +#define CvWEAKOUTSIDE_on(cv) (CvFLAGS(cv) |= CVf_WEAKOUTSIDE) +#define CvWEAKOUTSIDE_off(cv) (CvFLAGS(cv) &= ~CVf_WEAKOUTSIDE) + + +/* +=head1 CV reference counts and CvOUTSIDE + +=for apidoc m|bool|CvWEAKOUTSIDE|CV *cv + +Each CV has a pointer, C<CvOUTSIDE()>, to its lexically enclosing +CV (if any). Because pointers to anonymous sub prototypes are +stored in C<&> pad slots, it is a possible to get a circular reference, +with the parent pointing to the child and vice-versa. To avoid the +ensuing memory leak, we do not increment the reference count of the CV +pointed to by C<CvOUTSIDE> in the I<one specific instance> that the parent +has a C<&> pad slot pointing back to us. In this case, we set the +C<CvWEAKOUTSIDE> flag in the child. This allows us to determine under what +circumstances we should decrement the refcount of the parent when freeing +the child. + +There is a further complication with non-closure anonymous subs (ie those +that do not refer to any lexicals outside that sub). In this case, the +anonymous prototype is shared rather than being cloned. This has the +consequence that the parent may be freed while there are still active +children, eg + + BEGIN { $a = sub { eval '$x' } } + +In this case, the BEGIN is freed immediately after execution since there +are no active references to it: the anon sub prototype has +C<CvWEAKOUTSIDE> set since it's not a closure, and $a points to the same +CV, so it doesn't contribute to BEGIN's refcount either. When $a is +executed, the C<eval '$x'> causes the chain of C<CvOUTSIDE>s to be followed, +and the freed BEGIN is accessed. + +To avoid this, whenever a CV and its associated pad is freed, any +C<&> entries in the pad are explicitly removed from the pad, and if the +refcount of the pointed-to anon sub is still positive, then that +child's C<CvOUTSIDE> is set to point to its grandparent. This will only +occur in the single specific case of a non-closure anon prototype +having one or more active references (such as C<$a> above). + +One other thing to consider is that a CV may be merely undefined +rather than freed, eg C<undef &foo>. In this case, its refcount may +not have reached zero, but we still delete its pad and its C<CvROOT> etc. +Since various children may still have their C<CvOUTSIDE> pointing at this +undefined CV, we keep its own C<CvOUTSIDE> for the time being, so that +the chain of lexical scopes is unbroken. For example, the following +should print 123: + + my $x = 123; + sub tmp { sub { eval '$x' } } + my $a = tmp(); + undef &tmp; + print $a->(); + +=cut +*/ @@ -981,6 +981,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (CvLVALUE(sv)) sv_catpv(d, "LVALUE,"); if (CvMETHOD(sv)) sv_catpv(d, "METHOD,"); if (CvLOCKED(sv)) sv_catpv(d, "LOCKED,"); + if (CvWEAKOUTSIDE(sv)) sv_catpv(d, "WEAKOUTSIDE,"); break; case SVt_PVHV: if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,"); @@ -130,7 +130,7 @@ p |void |cv_ckproto |CV* cv|GV* gv|char* p pd |CV* |cv_clone |CV* proto Apd |SV* |cv_const_sv |CV* cv p |SV* |op_const_sv |OP* o|CV* cv -Ap |void |cv_undef |CV* cv +Apd |void |cv_undef |CV* cv Ap |void |cx_dump |PERL_CONTEXT* cs Ap |SV* |filter_add |filter_t funcp|SV* datasv Ap |void |filter_del |filter_t funcp diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index b54a5af97b..37b98a0343 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -15,7 +15,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY OPpCONST_ARYBASE OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER OPpSORT_REVERSE - SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR + SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE CVf_METHOD CVf_LOCKED CVf_LVALUE PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_SKIPWHITE PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED); @@ -1130,7 +1130,10 @@ sub lex_in_scope { sub populate_curcvlex { my $self = shift; for (my $cv = $self->{'curcv'}; class($cv) eq "CV"; $cv = $cv->OUTSIDE) { - my @padlist = $cv->PADLIST->ARRAY; + my $padlist = $cv->PADLIST; + # an undef CV still in lexical chain + next if class($padlist) eq "SPECIAL"; + my @padlist = $padlist->ARRAY; my @ns = $padlist[0]->ARRAY; for (my $i=0; $i<@ns; ++$i) { @@ -1141,8 +1144,10 @@ sub populate_curcvlex { next; } my $name = $ns[$i]->PVX; - my $seq_st = $ns[$i]->NVX; - my $seq_en = int($ns[$i]->IVX); + my ($seq_st, $seq_en) = + ($ns[$i]->FLAGS & SVf_FAKE) + ? (0, 999999) + : ($ns[$i]->NVX, $ns[$i]->IVX); push @{$self->{'curcvlex'}{$name}}, [$seq_st, $seq_en]; } diff --git a/ext/B/defsubs_h.PL b/ext/B/defsubs_h.PL index 37bfeb7e9d..2c2aecf6af 100644 --- a/ext/B/defsubs_h.PL +++ b/ext/B/defsubs_h.PL @@ -13,7 +13,7 @@ foreach my $const (qw( GVf_IMPORTED_AV GVf_IMPORTED_HV GVf_IMPORTED_SV GVf_IMPORTED_CV CVf_METHOD CVf_LOCKED CVf_LVALUE CVf_CONST - SVpad_OUR SVf_IOK SVf_IVisUV SVf_NOK SVf_POK + SVpad_OUR SVf_FAKE SVf_IOK SVf_IVisUV SVf_NOK SVf_POK SVf_ROK SVp_IOK SVp_POK SVp_NOK )) { diff --git a/ext/Devel/Peek/Peek.t b/ext/Devel/Peek/Peek.t index cdcf8114e1..a1ed214d19 100644 --- a/ext/Devel/Peek/Peek.t +++ b/ext/Devel/Peek/Peek.t @@ -206,7 +206,7 @@ do_test(13, RV = $ADDR SV = PVCV\\($ADDR\\) at $ADDR REFCNT = 2 - FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON\\) + FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\) IV = 0 NV = 0 PROTOTYPE = "" @@ -220,7 +220,7 @@ do_test(13, DEPTH = 0 (?: MUTEXP = $ADDR OWNER = $ADDR -)? FLAGS = 0x4 +)? FLAGS = 0x404 OUTSIDE_SEQ = \\d+ PADLIST = $ADDR PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\) @@ -3753,11 +3753,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 *freecv = Nullcv; - #ifdef USE_ITHREADS if (CvFILE(cv) && !CvXSUB(cv)) { /* for XSUBs CvFILE point directly to static memory; __FILE__ */ @@ -3782,24 +3791,21 @@ Perl_cv_undef(pTHX_ CV *cv) pad_undef(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 = CvOUTSIDE(cv); - CvOUTSIDE(cv) = Nullcv; + /* 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); } - if (freecv) - SvREFCNT_dec(freecv); if (CvXSUB(cv)) { CvXSUB(cv) = 0; } - CvFLAGS(cv) = 0; + /* delete all flags except WEAKOUTSIDE */ + CvFLAGS(cv) &= CVf_WEAKOUTSIDE; } void @@ -4161,13 +4167,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); @@ -198,6 +198,9 @@ PL_*pad* global vars so that we don't have any dangling references left. We also repoint the CvOUTSIDE of any about-to-be-orphaned inner subs to the outer of this cv. +(This function should really be called pad_free, but the name was already +taken) + =cut */ @@ -216,16 +219,15 @@ Perl_pad_undef(pTHX_ CV* cv) "Pad undef: padlist=0x%"UVxf"\n" , PTR2UV(padlist)) ); - /* pads may be cleared out already during global destruction */ - if ((CvEVAL(cv) && !CvGV(cv) /* is this eval"" ? */ - && !PL_dirty) || CvSPECIAL(cv)) - { - CV *outercv = CvOUTSIDE(cv); - U32 seq = CvOUTSIDE_SEQ(cv); - /* XXX DAPM the following code is very similar to - * pad_fixup_inner_anons(). Merge??? */ + /* detach any '&' anon children in the pad; if afterwards they + * are still live, fix up their CvOUTSIDEs to point to our outside, + * bypassing us. */ + /* XXX DAPM for efficiency, we should only do this if we know we have + * children, or integrate this loop with general cleanup */ - /* inner references to eval's/BEGIN's/etc cv must be fixed up */ + if (!PL_dirty) { /* don't bother during global destruction */ + CV *outercv = CvOUTSIDE(cv); + U32 seq = CvOUTSIDE_SEQ(cv); AV *comppad_name = (AV*)AvARRAY(padlist)[0]; SV **namepad = AvARRAY(comppad_name); AV *comppad = (AV*)AvARRAY(padlist)[1]; @@ -233,25 +235,26 @@ Perl_pad_undef(pTHX_ CV* cv) for (ix = AvFILLp(comppad_name); ix > 0; ix--) { SV *namesv = namepad[ix]; if (namesv && namesv != &PL_sv_undef - && *SvPVX(namesv) == '&' - && ix <= AvFILLp(comppad)) + && *SvPVX(namesv) == '&') { CV *innercv = (CV*)curpad[ix]; - if (innercv && SvTYPE(innercv) == SVt_PVCV + namepad[ix] = Nullsv; + SvREFCNT_dec(namesv); + curpad[ix] = Nullsv; + SvREFCNT_dec(innercv); + if (SvREFCNT(innercv) /* in use, not just a prototype */ && CvOUTSIDE(innercv) == cv) { + assert(CvWEAKOUTSIDE(innercv)); + CvWEAKOUTSIDE_off(innercv); CvOUTSIDE(innercv) = outercv; CvOUTSIDE_SEQ(innercv) = seq; - /* anon prototypes aren't refcounted */ - if (!CvANON(innercv) || CvCLONED(innercv)) { - (void)SvREFCNT_inc(outercv); - if (SvREFCNT(cv)) - SvREFCNT_dec(cv); - } + SvREFCNT_inc(outercv); } } } } + ix = AvFILLp(padlist); while (ix >= 0) { SV* sv = AvARRAY(padlist)[ix--]; @@ -434,6 +437,14 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type) /* XXX DAPM use PL_curpad[] ? */ av_store(PL_comppad, ix, sv); SvPADMY_on(sv); + + /* to avoid ref loops, we never have parent + child referencing each + * other simultaneously */ + if (CvOUTSIDE((CV*)sv)) { + assert(!CvWEAKOUTSIDE((CV*)sv)); + CvWEAKOUTSIDE_on((CV*)sv); + SvREFCNT_dec(CvOUTSIDE((CV*)sv)); + } return ix; } @@ -611,6 +622,8 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, CV* innercv) ); curlist = CvPADLIST(cv); + if (!curlist) + continue; /* an undef CV */ svp = av_fetch(curlist, 0, FALSE); if (!svp || *svp == &PL_sv_undef) continue; @@ -1277,7 +1290,7 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside) cv = PL_compcv = (CV*)NEWSV(1104, 0); sv_upgrade((SV *)cv, SvTYPE(proto)); - CvFLAGS(cv) = CvFLAGS(proto) & ~CVf_CLONE; + CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE); CvCLONED_on(cv); #ifdef USE_ITHREADS @@ -1359,6 +1372,9 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside) CvCLONE_on(kid); SvPADMY_on(kid); PL_curpad[ix] = (SV*)kid; + /* '&' entry points to child, so child mustn't refcnt parent */ + CvWEAKOUTSIDE_on(kid); + SvREFCNT_dec(cv); } } @@ -1387,7 +1403,8 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside) =for apidoc pad_fixup_inner_anons For any anon CVs in the pad, change CvOUTSIDE of that CV from -old_cv to new_cv if necessary. +old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be +moved to a pre-existing CV struct. =cut */ @@ -1406,18 +1423,14 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv) && *SvPVX(namesv) == '&') { CV *innercv = (CV*)curpad[ix]; - if (CvOUTSIDE(innercv) == old_cv) { - CvOUTSIDE(innercv) = new_cv; - /* anon prototypes aren't refcounted */ - if (!CvANON(innercv) || CvCLONED(innercv)) { - (void)SvREFCNT_inc(new_cv); - SvREFCNT_dec(old_cv); - } - } + assert(CvWEAKOUTSIDE(innercv)); + assert(CvOUTSIDE(innercv) == old_cv); + CvOUTSIDE(innercv) = new_cv; } } } + /* =for apidoc pad_push diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 772be5f237..65b2878b17 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -562,6 +562,18 @@ Found in file cv.h =over 8 +=item 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. + + void cv_undef(CV* cv) + +=for hackers +Found in file op.c + =item load_module Loads the module whose name is pointed to by the string part of name. diff --git a/pod/perlintern.pod b/pod/perlintern.pod index ea5c902c0f..c2e246a8d9 100644 --- a/pod/perlintern.pod +++ b/pod/perlintern.pod @@ -11,6 +11,67 @@ format but are not marked as part of the Perl API. In other words, B<they are not for use in extensions>! +=head1 CV reference counts and CvOUTSIDE + +=over 8 + +=item CvWEAKOUTSIDE + +Each CV has a pointer, C<CvOUTSIDE()>, to its lexically enclosing +CV (if any). Because pointers to anonymous sub prototypes are +stored in C<&> pad slots, it is a possible to get a circular reference, +with the parent pointing to the child and vice-versa. To avoid the +ensuing memory leak, we do not increment the reference count of the CV +pointed to by C<CvOUTSIDE> in the I<one specific instance> that the parent +has a C<&> pad slot pointing back to us. In this case, we set the +C<CvWEAKOUTSIDE> flag in the child. This allows us to determine under what +circumstances we should decrement the refcount of the parent when freeing +the child. + +There is a further complication with non-closure anonymous subs (ie those +that do not refer to any lexicals outside that sub). In this case, the +anonymous prototype is shared rather than being cloned. This has the +consequence that the parent may be freed while there are still active +children, eg + + BEGIN { $a = sub { eval '$x' } } + +In this case, the BEGIN is freed immediately after execution since there +are no active references to it: the anon sub prototype has +C<CvWEAKOUTSIDE> set since it's not a closure, and $a points to the same +CV, so it doesn't contribute to BEGIN's refcount either. When $a is +executed, the C<eval '$x'> causes the chain of C<CvOUTSIDE>s to be followed, +and the freed BEGIN is accessed. + +To avoid this, whenever a CV and its associated pad is freed, any +C<&> entries in the pad are explicitly removed from the pad, and if the +refcount of the pointed-to anon sub is still positive, then that +child's C<CvOUTSIDE> is set to point to its grandparent. This will only +occur in the single specific case of a non-closure anon prototype +having one or more active references (such as C<$a> above). + +One other thing to consider is that a CV may be merely undefined +rather than freed, eg C<undef &foo>. In this case, its refcount may +not have reached zero, but we still delete its pad and its C<CvROOT> etc. +Since various children may still have their C<CvOUTSIDE> pointing at this +undefined CV, we keep its own C<CvOUTSIDE> for the time being, so that +the chain of lexical scopes is unbroken. For example, the following +should print 123: + + my $x = 123; + sub tmp { sub { eval '$x' } } + my $a = tmp(); + undef &tmp; + print $a->(); + + bool CvWEAKOUTSIDE(CV *cv) + +=for hackers +Found in file cv.h + + +=back + =head1 Functions in file pad.h @@ -550,7 +611,8 @@ Found in file pad.c =item pad_fixup_inner_anons For any anon CVs in the pad, change CvOUTSIDE of that CV from -old_cv to new_cv if necessary. +old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be +moved to a pre-existing CV struct. void pad_fixup_inner_anons(PADLIST *padlist, CV *old_cv, CV *new_cv) @@ -651,6 +713,9 @@ PL_*pad* global vars so that we don't have any dangling references left. We also repoint the CvOUTSIDE of any about-to-be-orphaned inner subs to the outer of this cv. +(This function should really be called pad_free, but the name was already +taken) + void pad_undef(CV* cv) =for hackers @@ -2700,7 +2700,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) cxstack[cxstack_ix].blk_eval.cv = PL_compcv; CvOUTSIDE_SEQ(PL_compcv) = seq; - CvOUTSIDE(PL_compcv) = outside ? (CV*)SvREFCNT_inc(outside) : outside; + CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outside); /* set up a scratch pad */ @@ -9602,12 +9602,11 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param) CvDEPTH(dstr) = 0; } PAD_DUP(CvPADLIST(dstr), CvPADLIST(sstr), param); - /* anon prototypes aren't refcounted */ - if (!CvANON(sstr) || CvCLONED(sstr)) - CvOUTSIDE(dstr) = cv_dup_inc(CvOUTSIDE(sstr), param); - else - CvOUTSIDE(dstr) = cv_dup(CvOUTSIDE(sstr), param); - CvOUTSIDE_SEQ(dstr) = CvOUTSIDE_SEQ(sstr); + CvOUTSIDE_SEQ(dstr) = CvOUTSIDE_SEQ(sstr); + CvOUTSIDE(dstr) = + CvWEAKOUTSIDE(sstr) + ? cv_dup( CvOUTSIDE(sstr), param) + : cv_dup_inc(CvOUTSIDE(sstr), param); CvFLAGS(dstr) = CvFLAGS(sstr); CvFILE(dstr) = CvXSUB(sstr) ? CvFILE(sstr) : SAVEPV(CvFILE(sstr)); break; diff --git a/t/op/closure.t b/t/op/closure.t index 4e8694e756..6a81a44f36 100755 --- a/t/op/closure.t +++ b/t/op/closure.t @@ -13,7 +13,7 @@ BEGIN { use Config; -print "1..177\n"; +print "1..181\n"; my $test = 1; sub test (&) { @@ -510,11 +510,33 @@ END } -# The following dumps core with perl <= 5.8.0 +# The following dumps core with perl <= 5.8.0 (bugid 9535) ... BEGIN { $vanishing_pad = sub { eval $_[0] } } $some_var = 123; test { $vanishing_pad->( '$some_var' ) == 123 }; +# ... and here's another coredump variant - this time we explicitly +# delete the sub rather than using a BEGIN ... + +sub deleteme { $a = sub { eval '$newvar' } } +deleteme(); +*deleteme = sub {}; # delete the sub +$newvar = 123; # realloc the SV of the freed CV +test { $a->() == 123 }; + +# ... and a further coredump variant - the fixup of the anon sub's +# CvOUTSIDE pointer when the middle eval is freed, wasn't good enough to +# survive the outer eval also being freed. + +$x = 123; +$a = eval q( + eval q[ + sub { eval '$x' } + ] +); +@a = ('\1\1\1\1\1\1\1') x 100; # realloc recently-freed CVs +test { $a->() == 123 }; + # this coredumped on <= 5.8.0 because evaling the closure caused # an SvFAKE to be added to the outer anon's pad, which was then grown. my $outer; @@ -549,3 +571,36 @@ test {1}; } fake(); +# undefining a sub shouldn't alter visibility of outer lexicals + +{ + $x = 1; + my $x = 2; + sub tmp { sub { eval '$x' } } + my $a = tmp(); + undef &tmp; + test { $a->() == 2 }; +} + +# handy class: $x = Watch->new(\$foo,'bar') +# causes 'bar' to be appended to $foo when $x is destroyed +sub Watch::new { bless [ $_[1], $_[2] ], $_[0] } +sub Watch::DESTROY { ${$_[0][0]} .= $_[0][1] } + + +# bugid 1028: +# nested anon subs (and associated lexicals) not freed early enough + +sub linger { + my $x = Watch->new($_[0], '2'); + sub { + $x; + my $y; + sub { $y; }; + }; +} +{ + my $watch = '1'; + linger(\$watch); + test { $watch eq '12' } +} |