X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pad.c;h=b5e39fa3376ccfdb9d1b596fedc1a6e651597484;hb=523f125d4a71aa467fc6a9acfe6c304944f5a5f5;hp=51592d09379708024df72058e881f3fb033a7c7d;hpb=12bd6ede29d13c215438daf78d15695e487886b0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pad.c b/pad.c index 51592d0..b5e39fa 100644 --- a/pad.c +++ b/pad.c @@ -102,6 +102,8 @@ to be generated in evals, such as { my $x = 1; sub f { eval '$x'} } f(); +For state vars, SVf_PADSTALE is overloaded to mean 'not yet initialised' + =cut */ @@ -126,6 +128,9 @@ to be generated in evals, such as #ifdef PERL_MAD void pad_peg(const char* s) { static int pegcnt; + + PERL_ARGS_ASSERT_PAD_PEG; + pegcnt++; } #endif @@ -248,6 +253,8 @@ Perl_pad_undef(pTHX_ CV* cv) I32 ix; const PADLIST * const padlist = CvPADLIST(cv); + PERL_ARGS_ASSERT_PAD_UNDEF; + pad_peg("pad_undef"); if (!padlist) return; @@ -255,8 +262,8 @@ Perl_pad_undef(pTHX_ CV* cv) return; DEBUG_X(PerlIO_printf(Perl_debug_log, - "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf"\n", - PTR2UV(cv), PTR2UV(padlist)) + "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf" comppad=0x%"UVxf"\n", + PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad)) ); /* detach any '&' anon children in the pad; if afterwards they @@ -350,6 +357,8 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake SV* const namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV); + PERL_ARGS_ASSERT_PAD_ADD_NAME; + ASSERT_CURPAD_ACTIVE("pad_add_name"); sv_setpv(namesv, name); @@ -485,6 +494,9 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type) dVAR; PADOFFSET ix; SV* const name = newSV_type(SVt_PVNV); + + PERL_ARGS_ASSERT_PAD_ADD_ANON; + pad_peg("add_anon"); sv_setpvn(name, "&", 1); /* Are these two actually ever read? */ @@ -529,6 +541,8 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) SV **svp; PADOFFSET top, off; + PERL_ARGS_ASSERT_PAD_CHECK_DUP; + ASSERT_CURPAD_ACTIVE("pad_check_dup"); if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC)) return; /* nothing to check */ @@ -602,6 +616,8 @@ Perl_pad_findmy(pTHX_ const char *name) const AV *nameav; SV **name_svp; + PERL_ARGS_ASSERT_PAD_FINDMY; + pad_peg("pad_findmy"); offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1, NULL, &out_sv, &out_flags); @@ -683,6 +699,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SV **new_capturep; const AV * const padlist = CvPADLIST(cv); + PERL_ARGS_ASSERT_PAD_FINDLEX; + *out_flags = 0; DEBUG_Xv(PerlIO_printf(Perl_debug_log, @@ -768,6 +786,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, else { int newwarn = warn; if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI) + && !SvPAD_STATE(name_svp[offset]) && warn && ckWARN(WARN_CLOSURE)) { newwarn = 0; Perl_warner(aTHX_ packWARN(WARN_CLOSURE), @@ -796,7 +815,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n", PTR2UV(cv), PTR2UV(*out_capture))); - if (SvPADSTALE(*out_capture)) { + if (SvPADSTALE(*out_capture) + && !SvPAD_STATE(name_svp[offset])) + { if (ckWARN(WARN_CLOSURE)) Perl_warner(aTHX_ packWARN(WARN_CLOSURE), "Variable \"%s\" is not available", name); @@ -853,7 +874,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, ? SvSTASH(*out_name_sv) : NULL, SvOURSTASH(*out_name_sv), 1, /* fake */ - 0 /* not a state variable */ + SvPAD_STATE(*out_name_sv) ? 1 : 0 /* state variable ? */ ); new_namesv = AvARRAY(PL_comppad_name)[new_offset]; @@ -926,6 +947,9 @@ void Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv) { dVAR; + + PERL_ARGS_ASSERT_PAD_SETSV; + ASSERT_CURPAD_ACTIVE("pad_setsv"); DEBUG_X(PerlIO_printf(Perl_debug_log, @@ -1315,6 +1339,8 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full) SV **ppad; I32 ix; + PERL_ARGS_ASSERT_DO_DUMP_PAD; + if (!padlist) { return; } @@ -1384,6 +1410,8 @@ S_cv_dump(pTHX_ const CV *cv, const char *title) const CV * const outside = CvOUTSIDE(cv); AV* const padlist = CvPADLIST(cv); + PERL_ARGS_ASSERT_CV_DUMP; + PerlIO_printf(Perl_debug_log, " %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n", title, @@ -1437,6 +1465,8 @@ Perl_cv_clone(pTHX_ CV *proto) CV* outside; long depth; + PERL_ARGS_ASSERT_CV_CLONE; + assert(!CvUNIQUE(proto)); /* Since cloneable anon subs can be nested, CvOUTSIDE may point @@ -1494,17 +1524,17 @@ Perl_cv_clone(pTHX_ CV *proto) if (SvFAKE(namesv)) { /* lexical from outside? */ sv = outpad[PARENT_PAD_INDEX(namesv)]; assert(sv); - /* formats may have an inactive parent */ - if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) { + /* formats may have an inactive parent, + while my $x if $false can leave an active var marked as + stale. And state vars are always available */ + if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) { if (ckWARN(WARN_CLOSURE)) Perl_warner(aTHX_ packWARN(WARN_CLOSURE), "Variable \"%s\" is not available", SvPVX_const(namesv)); sv = NULL; } - else { - assert(!SvPADSTALE(sv)); + else SvREFCNT_inc_simple_void_NN(sv); - } } if (!sv) { const char sigil = SvPVX_const(namesv)[0]; @@ -1517,6 +1547,9 @@ Perl_cv_clone(pTHX_ CV *proto) else sv = newSV(0); SvPADMY_on(sv); + /* reset the 'assign only once' flag on each state var */ + if (SvPAD_STATE(namesv)) + SvPADSTALE_on(sv); } } else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) { @@ -1577,6 +1610,8 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv) AV * const comppad = (AV*)AvARRAY(padlist)[1]; SV ** const namepad = AvARRAY(comppad_name); SV ** const curpad = AvARRAY(comppad); + + PERL_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS; PERL_UNUSED_ARG(old_cv); for (ix = AvFILLp(comppad_name); ix > 0; ix--) { @@ -1607,6 +1642,9 @@ void Perl_pad_push(pTHX_ PADLIST *padlist, int depth) { dVAR; + + PERL_ARGS_ASSERT_PAD_PUSH; + if (depth > AvFILLp(padlist)) { SV** const svp = AvARRAY(padlist); AV* const newpad = newAV();