X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/fdf8c08824a2cd37d9fab91f3056bff4358cb60b..2234743e59ac597da46b3d44c7d8852855750374:/pad.c diff --git a/pad.c b/pad.c index 415b59e..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 @@ -168,7 +173,7 @@ Perl_pad_new(pTHX_ int flags) SAVEI32(PL_comppad_name_fill); SAVEI32(PL_min_intro_pending); SAVEI32(PL_max_intro_pending); - SAVEI32(PL_cv_has_eval); + SAVEBOOL(PL_cv_has_eval); if (flags & padnew_SAVESUB) { SAVEI32(PL_pad_reset_pending); } @@ -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 @@ -347,12 +354,13 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake { dVAR; const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY); - SV* const namesv = newSV(0); + SV* const namesv + = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV); - ASSERT_CURPAD_ACTIVE("pad_add_name"); + PERL_ARGS_ASSERT_PAD_ADD_NAME; + ASSERT_CURPAD_ACTIVE("pad_add_name"); - sv_upgrade(namesv, (ourstash || typestash) ? SVt_PVMG : SVt_PVNV); sv_setpv(namesv, name); if (typestash) { @@ -485,9 +493,11 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type) { dVAR; PADOFFSET ix; - SV* const name = newSV(0); + SV* const name = newSV_type(SVt_PVNV); + + PERL_ARGS_ASSERT_PAD_ADD_ANON; + pad_peg("add_anon"); - sv_upgrade(name, SVt_PVNV); sv_setpvn(name, "&", 1); /* Are these two actually ever read? */ COP_SEQ_RANGE_HIGH_set(name, ~0); @@ -531,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 */ @@ -552,7 +564,7 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) break; /* "our" masking "our" */ Perl_warner(aTHX_ packWARN(WARN_MISC), "\"%s\" variable %s masks earlier declaration in same %s", - (is_our ? "our" : PL_in_my == KEY_my ? "my" : "state"), + (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"), name, (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX ? "scope" : "statement")); --off; @@ -604,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); @@ -685,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, @@ -770,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), @@ -798,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); @@ -855,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]; @@ -928,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, @@ -1317,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; } @@ -1386,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, @@ -1439,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 @@ -1457,8 +1485,7 @@ Perl_cv_clone(pTHX_ CV *proto) ENTER; SAVESPTR(PL_compcv); - cv = PL_compcv = (CV*)newSV(0); - sv_upgrade((SV *)cv, SvTYPE(proto)); + cv = PL_compcv = (CV*)newSV_type(SvTYPE(proto)); CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE); CvCLONED_on(cv); @@ -1497,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]; @@ -1520,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])) { @@ -1580,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--) { @@ -1610,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(); @@ -1622,7 +1657,10 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) for ( ;ix > 0; ix--) { if (names_fill >= ix && names[ix] != &PL_sv_undef) { const char sigil = SvPVX_const(names[ix])[0]; - if ((SvFLAGS(names[ix]) & SVf_FAKE) || sigil == '&') { + if ((SvFLAGS(names[ix]) & SVf_FAKE) + || (SvFLAGS(names[ix]) & SVpad_STATE) + || sigil == '&') + { /* outer lexical or anon code */ av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); }