diff options
| -rw-r--r-- | op.c | 29 | ||||
| -rw-r--r-- | pad.c | 26 | ||||
| -rw-r--r-- | pp.c | 4 | ||||
| -rw-r--r-- | scope.c | 14 |
4 files changed, 19 insertions, 54 deletions
@@ -6981,12 +6981,9 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) cv = *spot; else { MAGIC *mg; + SvUPGRADE(name, SVt_PVMG); + mg = mg_find(name, PERL_MAGIC_proto); assert (SvTYPE(*spot) == SVt_PVCV); - if (CvROOT(*spot)) { - cv = *spot; - *svspot = newSV_type(SVt_PVCV); - SvPADMY_on(*spot); - } if (CvNAMED(*spot)) hek = CvNAME_HEK(*spot); else { @@ -6997,14 +6994,13 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) ) ); } - mg = mg_find(*svspot, PERL_MAGIC_proto); if (mg) { assert(mg->mg_obj); cv = (CV *)mg->mg_obj; } else { - sv_magic(*svspot, &PL_sv_undef, PERL_MAGIC_proto, NULL, 0); - mg = mg_find(*svspot, PERL_MAGIC_proto); + sv_magic(name, &PL_sv_undef, PERL_MAGIC_proto, NULL, 0); + mg = mg_find(name, PERL_MAGIC_proto); } spot = (CV **)(svspot = &mg->mg_obj); } @@ -9888,23 +9884,22 @@ Perl_rv2cv_op_cv(pTHX_ OP *cvop, U32 flags) case OP_PADCV: { PADNAME *name = PAD_COMPNAME(rvop->op_targ); CV *compcv = PL_compcv; - SV *sv = PAD_SV(rvop->op_targ); - while (SvTYPE(sv) != SVt_PVCV) { - assert(PadnameOUTER(name)); + PADOFFSET off = rvop->op_targ; + while (PadnameOUTER(name)) { assert(PARENT_PAD_INDEX(name)); compcv = CvOUTSIDE(PL_compcv); - sv = AvARRAY(PadlistARRAY(CvPADLIST(compcv))[1]) - [PARENT_PAD_INDEX(name)]; name = PadlistNAMESARRAY(CvPADLIST(compcv)) - [PARENT_PAD_INDEX(name)]; + [off = PARENT_PAD_INDEX(name)]; } - if (!PadnameIsOUR(name) && !PadnameIsSTATE(name)) { - MAGIC * mg = mg_find(sv, PERL_MAGIC_proto); + assert(!PadnameIsOUR(name)); + if (!PadnameIsSTATE(name)) { + MAGIC * mg = mg_find(name, PERL_MAGIC_proto); assert(mg); assert(mg->mg_obj); cv = (CV *)mg->mg_obj; } - else cv = (CV *)sv; + else cv = + (CV *)AvARRAY(PadlistARRAY(CvPADLIST(compcv))[1])[off]; gv = NULL; } break; default: { @@ -1383,6 +1383,8 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, else { /* immediate creation - capture outer value right now */ av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep)); + /* But also note the offset, as newMYSUB needs it */ + PARENT_PAD_INDEX_set(new_namesv, offset); DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n", PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset)); @@ -2059,26 +2061,9 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside) else if (PadnameLEN(namesv)>1 && !PadnameIsOUR(namesv)) { /* my sub */ - sv = newSV_type(SVt_PVCV); - if (SvTYPE(ppad[ix]) == SVt_PVCV) { - /* This is actually a stub with a proto CV attached - to it by magic. Since the stub itself is used - when the proto is cloned, we need a new stub - that nonetheless shares the same proto. - */ - MAGIC * const mg = - mg_find(ppad[ix], PERL_MAGIC_proto); - assert(mg); - assert(mg->mg_obj); - assert(SvTYPE(ppad[ix]) == SVt_PVCV); - assert(CvNAME_HEK((CV *)ppad[ix])); - CvNAME_HEK_set(sv, - share_hek_hek(CvNAME_HEK((CV *)ppad[ix]))); - sv_magic(sv,mg->mg_obj,PERL_MAGIC_proto,NULL,0); - } - else { - assert(SvTYPE(ppad[ix]) == SVt_NULL); - /* Unavailable; just provide a stub, but name it */ + /* Just provide a stub, but name it. It will be + upgrade to the real thing on scope entry. */ + sv = newSV_type(SVt_PVCV); CvNAME_HEK_set( sv, share_hek(SvPVX_const(namesv)+1, @@ -2086,7 +2071,6 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside) * (SvUTF8(namesv) ? -1 : 1), 0) ); - } } else sv = SvREFCNT_inc(ppad[ix]); else if (sigil == '@') @@ -162,13 +162,13 @@ PP(pp_introcv) PP(pp_clonecv) { dVAR; dTARGET; - MAGIC * const mg = mg_find(TARG, PERL_MAGIC_proto); + MAGIC * const mg = + mg_find(AvARRAY(PL_comppad_name)[ARGTARG], PERL_MAGIC_proto); assert(SvTYPE(TARG) == SVt_PVCV); assert(mg); assert(mg->mg_obj); if (CvISXSUB(mg->mg_obj)) { /* constant */ /* XXX Should we clone it here? */ - /* XXX Does this play nicely with pad_push? */ /* If this changes to use SAVECLEARSV, we can move the SAVECLEARSV to introcv and remove the SvPADSTALE_off. */ SAVEPADSVANDMORTALIZE(ARGTARG); @@ -955,8 +955,6 @@ Perl_leave_scope(pTHX_ I32 base) case SVt_PVCV: { SV ** const svp = (SV **)ptr; - MAGIC *mg = SvMAGIC(sv); - MAGIC **tomg = &SvMAGIC(sv); /* Create a stub */ *svp = newSV_type(SVt_PVCV); @@ -965,18 +963,6 @@ Perl_leave_scope(pTHX_ I32 base) assert(CvNAMED(sv)); CvNAME_HEK_set(*svp, share_hek_hek(CvNAME_HEK((CV *)sv))); - - /* Steal magic */ - while (mg) { - if (mg->mg_type == PERL_MAGIC_proto) break; - mg = *(tomg = &mg->mg_moremagic); - } - assert(mg); - *tomg = mg->mg_moremagic; - mg->mg_moremagic = SvMAGIC(*svp); - SvMAGIC(*svp) = mg; - mg_magical(*svp); - mg_magical(sv); break; } default: *(SV**)ptr = newSV(0); break; |