X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Upper.xs;h=20fa5d662013c10dc685bd656fee919a9753c3b9;hb=a09dde4832af673cb9fc0c32222db6da34d70999;hp=89083850cd9209579c880f9bade1d22e89bfbb74;hpb=f43a242b7a060b39234a12159de86b2bf56ff37a;p=perl%2Fmodules%2FScope-Upper.git

diff --git a/Upper.xs b/Upper.xs
index 8908385..20fa5d6 100644
--- a/Upper.xs
+++ b/Upper.xs
@@ -44,6 +44,10 @@
 # define SvPV_nolen_const(S) SvPV_nolen(S)
 #endif
 
+#ifndef SvREFCNT_inc_simple_void
+# define SvREFCNT_inc_simple_void(sv) SvREFCNT_inc(sv)
+#endif
+
 #ifndef HvNAME_get
 # define HvNAME_get(H) HvNAME(H)
 #endif
@@ -176,7 +180,7 @@ STATIC void su_save_adelete(pTHX_ AV *av, I32 idx) {
  Newx(ud, 1, su_ud_adelete);
  ud->av  = av;
  ud->idx = idx;
- SvREFCNT_inc(av);
+ SvREFCNT_inc_simple_void(av);
 
  SAVEDESTRUCTOR_X(su_adelete, ud);
 }
@@ -279,7 +283,6 @@ STATIC void su_call(pTHX_ void *ud_) {
  su_ud_reap *ud = (su_ud_reap *) ud_;
 #if SU_HAS_PERL(5, 9, 5)
  PERL_CONTEXT saved_cx;
- I32 dieing = PL_op->op_type == OP_DIE;
  I32 cxix;
 #endif
 
@@ -301,20 +304,17 @@ STATIC void su_call(pTHX_ void *ud_) {
   * the sub scope from call_sv, although it's still needed in our caller. */
 
 #if SU_HAS_PERL(5, 9, 5)
- if (dieing) {
-  if (cxstack_ix < cxstack_max)
-   cxix = cxstack_ix + 1;
-  else
-   cxix = Perl_cxinc(aTHX);
-  saved_cx = cxstack[cxix];
- }
+ if (cxstack_ix < cxstack_max)
+  cxix = cxstack_ix + 1;
+ else
+  cxix = Perl_cxinc(aTHX);
+ saved_cx = cxstack[cxix];
 #endif
 
  call_sv(ud->cb, G_VOID);
 
 #if SU_HAS_PERL(5, 9, 5)
- if (dieing)
-  cxstack[cxix] = saved_cx;
+ cxstack[cxix] = saved_cx;
 #endif
 
  PUTBACK;
@@ -352,7 +352,7 @@ STATIC void su_ud_localize_init(pTHX_ su_ud_localize *ud, SV *sv, SV *val, SV *e
  UV deref = 0;
  svtype t = SVt_NULL;
 
- SvREFCNT_inc(sv);
+ SvREFCNT_inc_simple_void(sv);
 
  if (SvTYPE(sv) >= SVt_PVGV) {
   if (!val || !SvROK(val)) { /* local *x; or local *x = $val; */
@@ -397,6 +397,7 @@ STATIC void su_ud_localize_init(pTHX_ su_ud_localize *ud, SV *sv, SV *val, SV *e
   case SVt_PVCV:
   case SVt_PVGV:
    deref = 0;
+  default:
    break;
  }
  /* When deref is set, val isn't NULL */
@@ -420,11 +421,11 @@ STATIC void su_localize(pTHX_ void *ud_) {
   gv = (GV *) sv;
  } else {
 #ifdef gv_fetchsv
-  gv = gv_fetchsv(sv, GV_ADDMULTI, SVt_PVGV);
+  gv = gv_fetchsv(sv, GV_ADDMULTI, t);
 #else
   STRLEN len;
   const char *name = SvPV_const(sv, len);
-  gv = gv_fetchpvn_flags(name, len, GV_ADDMULTI, SVt_PVGV);
+  gv = gv_fetchpvn_flags(name, len, GV_ADDMULTI, t);
 #endif
  }
 
@@ -701,18 +702,21 @@ STATIC void su_unwind(pTHX_ void *ud_) {
 
 #define SU_SKIP_DB(C) \
  STMT_START {         \
-  I32 i = 1;          \
-  PERL_CONTEXT *cx = cxstack + (C); \
-  do {                              \
-   if (CxTYPE(cx) == CXt_BLOCK && (C) >= i) { \
-    --cx;                                     \
-    if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.cv == GvCV(PL_DBsub)) { \
-     (C) -= i + 1;                 \
-     break;                        \
-    }                              \
-   } else                          \
-    break;                         \
-  } while (++i <= SU_SKIP_DB_MAX); \
+  I32 skipped = 0;    \
+  PERL_CONTEXT *base = cxstack;      \
+  PERL_CONTEXT *cx   = base + (C);   \
+  while (cx >= base && (C) > skipped && CxTYPE(cx) == CXt_BLOCK) \
+   --cx, ++skipped;                  \
+  if (cx >= base && (C) > skipped) { \
+   switch (CxTYPE(cx)) {  \
+    case CXt_SUB:         \
+     if (skipped <= SU_SKIP_DB_MAX && cx->blk_sub.cv == GvCV(PL_DBsub)) \
+      (C) -= skipped + 1; \
+      break;              \
+    default:              \
+     break;               \
+   }                      \
+  }                       \
  } STMT_END
 
 #define SU_GET_CONTEXT(A, B)   \