diff options
| -rw-r--r-- | pad.c | 13 | ||||
| -rw-r--r-- | t/cmd/lexsub.t | 10 |
2 files changed, 11 insertions, 12 deletions
@@ -1963,15 +1963,14 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside) SV** outpad; long depth; bool subclones = FALSE; -#ifdef DEBUGGING - CV * const outside_arg = outside; -#endif assert(!CvUNIQUE(proto)); /* Anonymous subs have a weak CvOUTSIDE pointer, so its value is not * reliable. The currently-running sub is always the one we need to * close over. + * For my subs, the currently-running sub may not be the one we want. + * We have to check whether it is a clone of CvOUTSIDE. * Note that in general for formats, CvOUTSIDE != find_runcv. * Since formats may be nested inside closures, CvOUTSIDE may point * to a prototype; we instead want the cloned parent who called us. @@ -1979,7 +1978,11 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside) if (!outside) { if (SvTYPE(proto) == SVt_PVCV) + { outside = find_runcv(NULL); + if (!CvANON(proto) && CvROOT(outside) != CvROOT(CvOUTSIDE(proto))) + outside = CvOUTSIDE(proto); + } else { outside = CvOUTSIDE(proto); if ((CvCLONE(outside) && ! CvCLONED(outside)) @@ -1993,9 +1996,6 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside) } } depth = outside ? CvDEPTH(outside) : 0; -#ifdef DEBUGGING - assert(depth || outside_arg || SvTYPE(proto) == SVt_PVFM); -#endif if (!depth) depth = 1; assert(SvTYPE(proto) == SVt_PVFM || CvPADLIST(outside)); @@ -2032,7 +2032,6 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside) if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)]) || ( SvPADSTALE(sv) && !SvPAD_STATE(namesv) && (!outside || !CvDEPTH(outside))) ) { - assert(SvTYPE(cv) == SVt_PVFM); Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE), "Variable \"%"SVf"\" is not available", namesv); sv = NULL; diff --git a/t/cmd/lexsub.t b/t/cmd/lexsub.t index 7fc3e5c0b6..293f70f226 100644 --- a/t/cmd/lexsub.t +++ b/t/cmd/lexsub.t @@ -519,21 +519,21 @@ sub not_lexical2 { }; bar } -$::TODO = 'closing over wrong sub'; is not_lexical3, 23, 'my subs inside predeclared package subs'; # Test my subs inside predeclared package sub, where the lexical sub is # declared outside the package sub. # This checks that CvOUTSIDE pointers are fixed up even when the sub is # not declared inside the sub that its CvOUTSIDE points to. -{ +sub not_lexical5 { my sub foo; sub not_lexical4; sub not_lexical4 { my $x = 234; + not_lexical5(); sub foo { $x } - foo } - is not_lexical4, 234, - 'my sub defined in predeclared pkg sub but declared outside'; + foo } +is not_lexical4, 234, + 'my sub defined in predeclared pkg sub but declared outside'; |