X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pad.c;h=cfd3787eb11eb25e7013944c1a8e6e7ec018cc9a;hb=a2309040b8fe324ae09c064137c624b4292d93c1;hp=cae1c02988c10b470fd78c0b8210639f8034f4f4;hpb=931b58fb28fa5ca73161678109fa052134ce70b3;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pad.c b/pad.c index cae1c02..cfd3787 100644 --- a/pad.c +++ b/pad.c @@ -1,6 +1,6 @@ /* pad.c * - * Copyright (C) 2002, 2003, 2004, 2005, 2006, by Larry Wall and others + * Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -75,7 +75,7 @@ The SVs in the names AV have their PV being the name of the variable. xlow+1..xhigh inclusive in the NV union is a range of cop_seq numbers for which the name is valid. For typed lexicals name SV is SVt_PVMG and SvSTASH points at the type. For C lexicals, the type is also SVt_PVMG, with the -OURSTASH slot pointing at the stash of the associated global (so that +SvOURSTASH slot pointing at the stash of the associated global (so that duplicate C declarations in the same package can be detected). SvUVX is sometimes hijacked to store the generation number during compilation. @@ -121,7 +121,7 @@ to be generated in evals, such as #define PARENT_FAKELEX_FLAGS_set(sv,val) \ STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END -#define PAD_MAX IV_MAX +#define PAD_MAX I32_MAX #ifdef PERL_MAD void pad_peg(const char* s) { @@ -168,7 +168,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); } @@ -255,8 +255,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 @@ -335,7 +335,7 @@ offset. If C is valid, the name is for a typed lexical; set the name's stash to that value. If C is valid, it's an our lexical, set the name's -OURSTASH to that value +SvOURSTASH to that value If fake, it means we're cloning an existing entry @@ -347,12 +347,11 @@ 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"); - - sv_upgrade(namesv, (ourstash || typestash) ? SVt_PVMG : SVt_PVNV); sv_setpv(namesv, name); if (typestash) { @@ -362,7 +361,7 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake } if (ourstash) { SvPAD_OUR_on(namesv); - OURSTASH_set(namesv, ourstash); + SvOURSTASH_set(namesv, ourstash); SvREFCNT_inc_simple_void_NN(ourstash); } else if (state) { @@ -485,9 +484,8 @@ 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); 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); @@ -552,7 +550,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; @@ -567,7 +565,7 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) && sv != &PL_sv_undef && !SvFAKE(sv) && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0) - && OURSTASH(sv) == ourstash + && SvOURSTASH(sv) == ourstash && strEQ(name, SvPVX_const(sv))) { Perl_warner(aTHX_ packWARN(WARN_MISC), @@ -853,7 +851,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SvPVX_const(*out_name_sv), SvPAD_TYPED(*out_name_sv) ? SvSTASH(*out_name_sv) : NULL, - OURSTASH(*out_name_sv), + SvOURSTASH(*out_name_sv), 1, /* fake */ 0 /* not a state variable */ ); @@ -1043,7 +1041,7 @@ Perl_pad_leavemy(pTHX) && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL)) Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "%"SVf" never introduced", - (void*)sv); + SVfARG(sv)); } } /* "Deintroduce" my variables that are leaving with this scope. */ @@ -1457,8 +1455,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 +1494,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 */ + if (SvPADSTALE(sv)) { 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 +1517,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])) { @@ -1622,7 +1622,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])); }