X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=blobdiff_plain;f=Upper.xs;h=27397091936b248267348e9bbe075f900311671f;hp=a5111f242029fd0ec84c13d87a8323e882712753;hb=3beb96a81eebadf62454ea90eecd4b9dd36bdce5;hpb=a5315939c4f295e3e6b70b3b6033068a8be67ce6

diff --git a/Upper.xs b/Upper.xs
index a5111f2..2739709 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;
@@ -1511,8 +1537,10 @@ STATIC void su_uplevel_restore(pTHX_ void *sus_) {
   * 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);
  }
 
@@ -1646,6 +1674,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
@@ -1663,13 +1694,13 @@ STATIC CV *su_cv_clone(pTHX_ CV *proto, GV *gv) {
   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
@@ -2075,8 +2106,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 +2142,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 +2173,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:
@@ -2353,7 +2384,6 @@ XS(XS_Scope__Upper_leave) {
  dXSARGS;
 #endif
  dMY_CXT;
- I32 cxix;
 
  PERL_UNUSED_VAR(cv); /* -W */
  PERL_UNUSED_VAR(ax); /* -Wall */
@@ -2572,7 +2602,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 +2710,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 {