diff options
| -rw-r--r-- | op.c | 27 | ||||
| -rwxr-xr-x | t/op/misc.t | 10 |
2 files changed, 29 insertions, 8 deletions
@@ -357,10 +357,12 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, saweval = i; seq = cxstack[i].blk_oldcop->cop_seq; startcv = cxstack[i].blk_eval.cv; - off = pad_findlex(name, newoff, seq, startcv, i-1, - saweval, 0); - if (off) /* continue looking if not found here */ - return off; + if (startcv && CvOUTSIDE(startcv)) { + off = pad_findlex(name, newoff, seq, CvOUTSIDE(startcv), + i-1, saweval, 0); + if (off) /* continue looking if not found here */ + return off; + } } break; case OP_DOFILE: @@ -4174,9 +4176,14 @@ Perl_cv_undef(pTHX_ CV *cv) * 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)) + * closure prototype, and the ensuing memory leak. This does not + * apply to closures generated within eval"", since eval"" CVs are + * ephemeral. --GSAR */ + if (!CvANON(cv) || CvCLONED(cv) + || (CvOUTSIDE(cv) && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv)))) + { SvREFCNT_dec(CvOUTSIDE(cv)); + } CvOUTSIDE(cv) = Nullcv; if (CvCONST(cv)) { SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr); @@ -4815,12 +4822,16 @@ 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. + /* If a potential closure prototype, don't keep a refcount on + * outer CV, unless the latter happens to be a passing eval"". * 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) + if (!name && CvOUTSIDE(cv) + && !(CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv)))) + { SvREFCNT_dec(CvOUTSIDE(cv)); + } if (name || aname) { char *s; diff --git a/t/op/misc.t b/t/op/misc.t index 881f99dc18..679dd91d0d 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -599,6 +599,16 @@ EOT EXPECT ok ######## +# test that closures generated by eval"" hold on to the CV of the eval"" +# for their entire lifetime +$code = eval q[ + sub { eval '$x = "ok 1\n"'; } +]; +&{$code}(); +print $x; +EXPECT +ok 1 +######## # This test is here instead of pragma/locale.t because # the bug depends on in the internal state of the locale # settings and pragma/locale messes up that state pretty badly. |