Fix building with SU_DEBUG defined on 5.8

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

diff --git a/Upper.xs b/Upper.xs
index 9c28d1720059cf4d7b7a1173af352210233e8d6f..76be07a58d7fe1095abbe58662e90b031d914cbc 100644 (file)
--- a/Upper.xs
+++ b/Upper.xs
@@ -397,7 +397,8 @@ STATIC void su_localize(pTHX_ void *ud_) {
  }
 
  SU_D({
-  SV *z = newSV_type(t);
+  SV *z = newSV(0);
+  SvUPGRADE(z, t);
   PerlIO_printf(Perl_debug_log, "%p: === localize a %s at %d (save is %d)\n",
                                  ud, sv_reftype(z, 0),
                                      PL_scopestack_ix, PL_savestack_ix);
@@ -490,6 +491,10 @@ STATIC void su_pop(pTHX_ void *ud) {
                                       ud, PL_savestack_ix, depth));
  } else {
   SU_UD_HANDLER(ud)(aTHX_ ud);
+#if SU_DEBUG
+  if (PL_scopestack[PL_scopestack_ix] != PL_savestack_ix)
+   PerlIO_printf(Perl_debug_log, "%p: expected: %2d got: %2d\n", ud, PL_scopestack_ix, PL_savestack_ix);
+#endif /* SU_DEBUG */
  }
 }
 
@@ -511,6 +516,19 @@ STATIC I32 su_init(pTHX_ I32 cxix, void *ud, I32 size) {
  for (i = cxstack_ix; i > cxix; --i) {
   PERL_CONTEXT *cx = cxstack + i;
   switch (CxTYPE(cx)) {
+#if SU_HAS_PERL(5, 10, 0)
+   case CXt_BLOCK:
+    SU_D(PerlIO_printf(Perl_debug_log, "%p: cx %d is block\n", ud, i));
+    /* Given and when blocks are actually followed by a simple block, so skip
+     * it if needed. */
+    if (cxix > 0) { /* Implies i > 0 */
+     PERL_CONTEXT *next = cx - 1;
+     if (CxTYPE(next) == CXt_GIVEN || CxTYPE(next) == CXt_WHEN)
+      --cxix;
+    }
+    depth++;
+    break;
+#endif
 #if SU_HAS_PERL(5, 11, 0)
    case CXt_LOOP_FOR:
    case CXt_LOOP_PLAIN:
@@ -523,7 +541,7 @@ STATIC I32 su_init(pTHX_ I32 cxix, void *ud, I32 size) {
     depth += 2;
     break;
    default:
-    SU_D(PerlIO_printf(Perl_debug_log, "%p: cx %d is normal\n", ud, i));
+    SU_D(PerlIO_printf(Perl_debug_log, "%p: cx %d is other\n", ud, i));
     depth++;
     break;
   }