X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Upper.xs;h=0e36df1e98a4cbc7f5b65be2d703442e3b61d2be;hb=57746d0b3de44a1205902e433488c8a1afe69469;hp=18ba9865e1190227a595e2e511bcedbd1935f6a1;hpb=502b805d3cf36b88e13f5010061260cef2c797e4;p=perl%2Fmodules%2FScope-Upper.git diff --git a/Upper.xs b/Upper.xs index 18ba986..0e36df1 100644 --- a/Upper.xs +++ b/Upper.xs @@ -256,6 +256,11 @@ static U8 su_op_gimme_reverse(U8 gimme) { # define MY_CXT_CLONE NOOP #endif +/* --- Error messages ------------------------------------------------------ */ + +static const char su_stack_smash[] = "Cannot target a scope outside of the current stack"; +static const char su_no_such_target[] = "No targetable %s scope in the current stack"; + /* --- Unique context ID global storage ------------------------------------ */ /* ... Sequence ID counter ................................................. */ @@ -2586,6 +2591,8 @@ PPCODE: --cxix; cxix = su_context_skip_db(cxix); cxix = su_context_normalize_up(cxix); + } else { + warn(su_stack_smash); } EXTEND(SP, 1); mPUSHi(cxix); @@ -2611,6 +2618,7 @@ PPCODE: XSRETURN(1); } } + warn(su_no_such_target, "subroutine"); XSRETURN_UNDEF; void @@ -2631,6 +2639,7 @@ PPCODE: XSRETURN(1); } } + warn(su_no_such_target, "eval"); XSRETURN_UNDEF; void @@ -2642,8 +2651,10 @@ PPCODE: SU_GET_LEVEL(0, 0); cxix = su_context_here(); while (--level >= 0) { - if (cxix <= 0) + if (cxix <= 0) { + warn(su_stack_smash); break; + } --cxix; cxix = su_context_skip_db(cxix); cxix = su_context_normalize_up(cxix); @@ -2673,6 +2684,8 @@ PPCODE: } } done: + if (level >= 0) + warn(su_stack_smash); EXTEND(SP, 1); mPUSHi(cxix); XSRETURN(1); @@ -2872,7 +2885,9 @@ CODE: cxix = su_context_normalize_down(cxix); Newx(ud, 1, su_ud_reap); SU_UD_TYPE(ud) = SU_UD_TYPE_REAP; - ud->cb = newSVsv(hook); + ud->cb = (SvROK(hook) && SvTYPE(SvRV(hook)) >= SVt_PVCV) + ? SvRV(hook) : hook; + SvREFCNT_inc_simple_void(ud->cb); su_init(ud, cxix, SU_SAVE_DESTRUCTOR_SIZE); void