Make t/63-uplevel-ctl.t pass with the debugger enabled

[perl/modules/Scope-Upper.git] / Upper.xs

diff --git a/Upper.xs b/Upper.xs
index 63d267b928aeb3c3a059d464001ac61d71bbb030..aea8e105409a012f837d0b131c932f3fdb5d5580 100644 (file)
--- a/Upper.xs
+++ b/Upper.xs
@@ -116,6 +116,11 @@ STATIC SV *su_newSV_type(pTHX_ svtype t) {
 # define CvISXSUB(C) CvXSUB(C)
 #endif
 
+#ifndef PadlistARRAY
+# define PadlistARRAY(P) AvARRAY(P)
+# define PadARRAY(P)     AvARRAY(P)
+#endif
+
 #ifndef CxHASARGS
 # define CxHASARGS(C) ((C)->blk_sub.hasargs)
 #endif
@@ -128,6 +133,22 @@ STATIC SV *su_newSV_type(pTHX_ svtype t) {
 # define gv_fetchpvn_flags(A, B, C, D) gv_fetchpv((A), (C), (D))
 #endif
 
+#ifndef OP_GIMME_REVERSE
+STATIC U8 su_op_gimme_reverse(U8 gimme) {
+ switch (gimme) {
+  case G_VOID:
+   return OPf_WANT_VOID;
+  case G_ARRAY:
+   return OPf_WANT_LIST;
+  default:
+   break;
+ }
+
+ return OPf_WANT_SCALAR;
+}
+#define OP_GIMME_REVERSE(G) su_op_gimme_reverse(G)
+#endif
+
 #ifndef PERL_MAGIC_tied
 # define PERL_MAGIC_tied 'P'
 #endif
@@ -660,6 +681,8 @@ typedef struct {
 
 /* ... Reap ................................................................ */
 
+#define SU_SAVE_LAST_CX (!SU_HAS_PERL(5, 8, 4) || (SU_HAS_PERL(5, 9, 5) && !SU_HAS_PERL(5, 14, 0)) || SU_HAS_PERL(5, 15, 0))
+
 typedef struct {
  su_ud_common ci;
  SV *cb;
@@ -667,10 +690,10 @@ typedef struct {
 
 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;
+#if SU_SAVE_LAST_CX
  I32 cxix;
-#endif
+ PERL_CONTEXT saved_cx;
+#endif /* SU_SAVE_LAST_CX */
 
  dSP;
 
@@ -686,22 +709,18 @@ STATIC void su_call(pTHX_ void *ud_) {
  PUSHMARK(SP);
  PUTBACK;
 
+#if SU_SAVE_LAST_CX
  /* If the recently popped context isn't saved there, it will be overwritten by
   * the sub scope from call_sv, although it's still needed in our caller. */
-
-#if SU_HAS_PERL(5, 9, 5)
- if (cxstack_ix < cxstack_max)
-  cxix = cxstack_ix + 1;
- else
-  cxix = Perl_cxinc(aTHX);
+ cxix     = (cxstack_ix < cxstack_max) ? (cxstack_ix + 1) : Perl_cxinc(aTHX);
  saved_cx = cxstack[cxix];
-#endif
+#endif /* SU_SAVE_LAST_CX */
 
  call_sv(ud->cb, G_VOID);
 
-#if SU_HAS_PERL(5, 9, 5)
+#if SU_SAVE_LAST_CX
  cxstack[cxix] = saved_cx;
-#endif
+#endif /* SU_SAVE_LAST_CX */
 
  PUTBACK;
 
@@ -890,9 +909,9 @@ done:
 
 #if SU_DEBUG
 # ifdef DEBUGGING
-#  define SU_CXNAME PL_block_type[CxTYPE(&cxstack[cxstack_ix])]
+#  define SU_CXNAME(C) PL_block_type[CxTYPE(C)]
 # else
-#  define SU_CXNAME "XXX"
+#  define SU_CXNAME(C) "XXX"
 # endif
 #endif
 
@@ -905,7 +924,7 @@ STATIC void su_pop(pTHX_ void *ud) {
   PerlIO_printf(Perl_debug_log,
    "%p: --- pop a %s\n"
    "%p: leave scope     at depth=%2d scope_ix=%2d cur_top=%2d cur_base=%2d\n",
-    ud, SU_CXNAME,
+    ud, SU_CXNAME(cxstack + cxstack_ix),
     ud, depth, PL_scopestack_ix,PL_savestack_ix,PL_scopestack[PL_scopestack_ix])
  );
 
@@ -1097,22 +1116,6 @@ STATIC void su_unwind(pTHX_ void *ud_) {
 
 /* --- Uplevel ------------------------------------------------------------- */
 
-#ifndef OP_GIMME_REVERSE
-STATIC U8 su_op_gimme_reverse(U8 gimme) {
- switch (gimme) {
-  case G_VOID:
-   return OPf_WANT_VOID;
-  case G_ARRAY:
-   return OPf_WANT_LIST;
-  default:
-   break;
- }
-
- return OPf_WANT_SCALAR;
-}
-#define OP_GIMME_REVERSE(G) su_op_gimme_reverse(G)
-#endif
-
 #define SU_UPLEVEL_SAVE(f, t) STMT_START { sud->old_##f = PL_##f; PL_##f = (t); } STMT_END
 #define SU_UPLEVEL_RESTORE(f) STMT_START { PL_##f = sud->old_##f; } STMT_END
 
@@ -1251,7 +1254,7 @@ done:
 
 #endif /* SU_UPLEVEL_HIJACKS_RUNOPS */
 
-#define su_at_underscore(C) AvARRAY(AvARRAY(CvPADLIST(C))[CvDEPTH(C)])[0]
+#define su_at_underscore(C) PadARRAY(PadlistARRAY(CvPADLIST(C))[CvDEPTH(C)])[0]
 
 STATIC void su_uplevel_restore(pTHX_ void *sus_) {
  su_uplevel_ud *sud = sus_;