]> git.vpit.fr Git - perl/modules/Scope-Upper.git/commitdiff
Preserve PL_scopestack[cx->blk_oldscopesp - 1] in su_pop()
authorVincent Pit <vince@profvince.com>
Fri, 27 Mar 2015 18:47:42 +0000 (15:47 -0300)
committerVincent Pit <vince@profvince.com>
Fri, 27 Mar 2015 18:47:42 +0000 (15:47 -0300)
Starting from perl 5.19.4 commit 2537512, pp_leavesub does a second
leave_scope(PL_scopestack[cx->blk_oldscopesp - 1]) just after the usual
LEAVE call. However, this index in the scope stack may be overwritten
by our own "flush" leave_scope() call in su_pop(). More precisely, this
seems to happen in sv_clear() (called from sv_free2() called from
sv_unref_flags() called from sv_force_normal_flags() called from
leave_scope()) and only when the debugger is enabled.

Upper.xs

index 7cbbaa2da3fe315efbbdf62c4cbd1e30265272b2..702481594747b6e41c6753b5f9304e1fecae3cf7 100644 (file)
--- a/Upper.xs
+++ b/Upper.xs
@@ -1001,9 +1001,26 @@ static void su_pop(pTHX_ void *ud) {
                      ud,                24, ' ',    mark,        base));
 
  if (base < mark) {
+#if SU_HAS_PERL(5, 19, 4)
+  I32 save = -1;
+  PERL_CONTEXT *cx;
+#endif
+
   SU_D(PerlIO_printf(Perl_debug_log, "%p: clear leftovers\n", ud));
+
+#if SU_HAS_PERL(5, 19, 4)
+  cx = cxstack + cxstack_ix;
+  if (CxTYPE(cx) == CXt_SUB)
+   save = PL_scopestack[cx->blk_oldscopesp - 1];
+#endif
+
   PL_savestack_ix = mark;
   leave_scope(base);
+
+#if SU_HAS_PERL(5, 19, 4)
+  if (CxTYPE(cx) == CXt_SUB)
+   PL_scopestack[cx->blk_oldscopesp - 1] = save;
+#endif
  }
  PL_savestack_ix = base;