X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Upper.xs;h=24f452d1521ae89bd83fcf15267fb7a769707b20;hb=937a967ba2770bc092c0ddbbb68f288c4bca853f;hp=a5111f242029fd0ec84c13d87a8323e882712753;hpb=a5315939c4f295e3e6b70b3b6033068a8be67ce6;p=perl%2Fmodules%2FScope-Upper.git diff --git a/Upper.xs b/Upper.xs index a5111f2..24f452d 100644 --- a/Upper.xs +++ b/Upper.xs @@ -197,6 +197,14 @@ STATIC U8 su_op_gimme_reverse(U8 gimme) { #define OP_GIMME_REVERSE(G) su_op_gimme_reverse(G) #endif +#ifndef OpSIBLING +# ifdef OP_SIBLING +# define OpSIBLING(O) OP_SIBLING(O) +# else +# define OpSIBLING(O) ((O)->op_sibling) +# endif +#endif + #ifndef PERL_MAGIC_tied # define PERL_MAGIC_tied 'P' #endif @@ -1126,6 +1134,15 @@ STATIC void su_unwind(pTHX_ void *ud_) { PERL_UNUSED_VAR(ud_); PL_stack_sp = MY_CXT.unwind_storage.savesp; +#if SU_HAS_PERL(5, 19, 4) + { + I32 i; + SV **sp = PL_stack_sp; + for (i = -items + 1; i <= 0; ++i) + if (!SvTEMP(sp[i])) + sv_2mortal(SvREFCNT_inc(sp[i])); + } +#endif if (cxstack_ix > cxix) dounwind(cxix); @@ -1301,6 +1318,15 @@ cxt_when: } PL_stack_sp = MY_CXT.yield_storage.savesp; +#if SU_HAS_PERL(5, 19, 4) + { + I32 i; + SV **sp = PL_stack_sp; + for (i = -items + 1; i <= 0; ++i) + if (!SvTEMP(sp[i])) + sv_2mortal(SvREFCNT_inc(sp[i])); + } +#endif if (cxstack_ix > cxix) dounwind(cxix); @@ -1383,7 +1409,7 @@ STATIC void su_uplevel_storage_delete(pTHX_ su_uplevel_ud *sud) { } STATIC int su_uplevel_goto_static(const OP *o) { - for (; o; o = o->op_sibling) { + for (; o; o = OpSIBLING(o)) { /* goto ops are unops with kids. */ if (!(o->op_flags & OPf_KIDS)) continue; @@ -1646,6 +1672,9 @@ STATIC CV *su_cv_clone(pTHX_ CV *proto, GV *gv) { #endif CvGV_set(cv, gv); +#if SU_RELEASE && SU_HAS_PERL_EXACT(5, 21, 4) + CvNAMED_off(cv); +#endif CvSTASH_set(cv, CvSTASH(proto)); /* Commit 4c74a7df, publicized with perl 5.13.3, began to add backrefs to * stashes. CvSTASH_set() started to do it as well with commit c68d95645 @@ -2075,8 +2104,8 @@ STATIC I32 su_context_normalize_up(pTHX_ I32 cxix) { return cxix - 1; break; case CXt_SUBST: - if (cx->blk_oldcop && cx->blk_oldcop->op_sibling - && cx->blk_oldcop->op_sibling->op_type == OP_SUBST) + if (cx->blk_oldcop && OpSIBLING(cx->blk_oldcop) + && OpSIBLING(cx->blk_oldcop)->op_type == OP_SUBST) return cxix - 1; break; } @@ -2111,8 +2140,8 @@ STATIC I32 su_context_normalize_down(pTHX_ I32 cxix) { return cxix + 1; break; case CXt_SUBST: - if (next->blk_oldcop && next->blk_oldcop->op_sibling - && next->blk_oldcop->op_sibling->op_type == OP_SUBST) + if (next->blk_oldcop && OpSIBLING(next->blk_oldcop) + && OpSIBLING(next->blk_oldcop)->op_type == OP_SUBST) return cxix + 1; break; } @@ -2142,8 +2171,8 @@ STATIC I32 su_context_gimme(pTHX_ I32 cxix) { #endif case CXt_SUBST: { const COP *cop = cx->blk_oldcop; - if (cop && cop->op_sibling) { - switch (cop->op_sibling->op_flags & OPf_WANT) { + if (cop && OpSIBLING(cop)) { + switch (OpSIBLING(cop)->op_flags & OPf_WANT) { case OPf_WANT_VOID: return G_VOID; case OPf_WANT_SCALAR: @@ -2572,7 +2601,7 @@ PPCODE: cx = cxstack + cxix; dbcx = cx; if (PL_DBsub && cxix && (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT)) { - I32 i = su_context_skip_db(cxix - 1) + 1;; + I32 i = su_context_skip_db(cxix - 1) + 1; if (i < cxix && CxTYPE(cxstack + i) == CXt_SUB) cx = cxstack + i; } @@ -2680,12 +2709,14 @@ context_info_warnings_off: } else if (old_warnings == pWARN_ALL) { HV *bits; context_info_warnings_on: +#if SU_HAS_PERL(5, 8, 7) bits = get_hv("warnings::Bits", 0); if (bits) { SV **bits_all = hv_fetchs(bits, "all", FALSE); if (bits_all) mask = sv_mortalcopy(*bits_all); } +#endif if (!mask) mask = su_newmortal_pvn(WARN_ALLstring, WARNsize); } else {