#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
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);
}
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);
}
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;
* depth to be 0, or perl would complain about it being "still in use".
* But we *know* that it cannot be so. */
if (sud->renamed) {
- CvDEPTH(sud->renamed) = 0;
- CvPADLIST(sud->renamed) = NULL;
+ if (!CvISXSUB(sud->renamed)) {
+ CvDEPTH(sud->renamed) = 0;
+ CvPADLIST(sud->renamed) = NULL;
+ }
SvREFCNT_dec(sud->renamed);
}
#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
CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
OP_REFCNT_UNLOCK;
CvSTART(cv) = CvSTART(proto);
+ CvPADLIST(cv) = CvPADLIST(proto);
}
CvOUTSIDE(cv) = CvOUTSIDE(proto);
#ifdef CVf_WEAKOUTSIDE
if (!(CvFLAGS(proto) & CVf_WEAKOUTSIDE))
#endif
SvREFCNT_inc_simple_void(CvOUTSIDE(cv));
- CvPADLIST(cv) = CvPADLIST(proto);
#ifdef CvOUTSIDE_SEQ
CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
#endif
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;
}
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;
}
#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:
dXSARGS;
#endif
dMY_CXT;
- I32 cxix;
PERL_UNUSED_VAR(cv); /* -W */
PERL_UNUSED_VAR(ax); /* -Wall */
} 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 {