X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Upper.xs;h=728cfecd663bfca78f00c7cd3161f51f8a758673;hb=f8031112ec9eddeae6ab2a23f703c80a456529c1;hp=7cbbaa2da3fe315efbbdf62c4cbd1e30265272b2;hpb=52f4d61f228f6e76a229b389c897932d2b5c3e62;p=perl%2Fmodules%2FScope-Upper.git diff --git a/Upper.xs b/Upper.xs index 7cbbaa2..728cfec 100644 --- 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 || CxTYPE(cx) == CXt_FORMAT) + 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 || CxTYPE(cx) == CXt_FORMAT) + PL_scopestack[cx->blk_oldscopesp - 1] = save; +#endif } PL_savestack_ix = base; @@ -1039,7 +1056,7 @@ static void su_pop(pTHX_ void *ud) { static I32 su_init(pTHX_ void *ud, I32 cxix, I32 size) { #define su_init(U, C, S) su_init(aTHX_ (U), (C), (S)) - I32 i, depth = 1, pad, offset, *origin; + I32 i, depth = 1, pad, offset, base, *origin; SU_D(PerlIO_printf(Perl_debug_log, "%p: ### init for cx %d\n", ud, cxix)); @@ -1079,11 +1096,12 @@ static I32 su_init(pTHX_ void *ud, I32 cxix, I32 size) { SU_D(PerlIO_printf(Perl_debug_log, "%p: going down to depth %d\n", ud, depth)); Newx(origin, depth + 1, I32); - origin[0] = PL_scopestack[PL_scopestack_ix - depth]; - PL_scopestack[PL_scopestack_ix - depth] += size; - for (i = depth - 1; i >= 1; --i) { - I32 j = PL_scopestack_ix - i; - origin[depth - i] = PL_scopestack[j]; + base = PL_scopestack_ix - depth; + origin[0] = PL_scopestack[base]; + PL_scopestack[base] += size; + for (i = 1; i < depth; ++i) { + I32 j = i + base; + origin[i] = PL_scopestack[j]; PL_scopestack[j] += offset; } origin[depth] = PL_savestack_ix; @@ -1203,12 +1221,12 @@ static void su_yield(pTHX_ void *ud_) { #if SU_HAS_PERL(5, 10, 0) if (cxix > 0) { PERL_CONTEXT *prev = cx - 1; - U8 type = CxTYPE(prev); - if ((type == CXt_GIVEN || type == CXt_WHEN) + U8 prev_type = CxTYPE(prev); + if ((prev_type == CXt_GIVEN || prev_type == CXt_WHEN) && (prev->blk_oldcop == cx->blk_oldcop)) { cxix--; cx = prev; - if (type == CXt_GIVEN) + if (prev_type == CXt_GIVEN) goto cxt_given; else goto cxt_when; @@ -2204,7 +2222,7 @@ static I32 su_context_gimme(pTHX_ I32 cxix) { /* --- Global setup/teardown ----------------------------------------------- */ -static U32 su_initialized = 0; +static VOL U32 su_initialized = 0; static void su_global_teardown(pTHX_ void *root) { if (!su_initialized)