From: David Mitchell Date: Mon, 16 May 2016 12:34:09 +0000 (+0100) Subject: Some basic 5.23.8 fixes X-Git-Tag: rt112246^2~16 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=f0ee3a495f7f12754a9e79ef83f9affc69ad2f66;p=perl%2Fmodules%2FScope-Upper.git Some basic 5.23.8 fixes The context system has changed a lot in 5.23.8. This commit just gets the code compiling again; it doesn';t attempt to fix any breakage. --- diff --git a/Upper.xs b/Upper.xs index f6ed5c6..efc799a 100644 --- a/Upper.xs +++ b/Upper.xs @@ -16,6 +16,12 @@ /* --- Compatibility ------------------------------------------------------- */ +/* perl 5.23.8 onwards has a revamped context system */ +#if XSH_HAS_PERL(5, 23, 8) +# define SU_HAS_NEW_CXT +#endif + + #ifndef dVAR # define dVAR dNOOP #endif @@ -197,6 +203,27 @@ static U8 su_op_gimme_reverse(U8 gimme) { # define NEGATIVE_INDICES_VAR "NEGATIVE_INDICES" #endif +/* CX_ARGARRAY(cx): the AV at pad[0] of the CV associated with CXt_SUB + * context cx */ + +#if XSH_HAS_PERL(5, 23, 8) +# define CX_ARGARRAY(cx) \ + ((AV*)(AvARRAY(MUTABLE_AV( \ + PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[ \ + CvDEPTH(cx->blk_sub.cv)]))[0])) +/* XXX is the new def ok to use in lvalue cxt? Formerly it assigned to + * blk_sub.argarray, now to pad[0]. Does this matter? + */ +# define CX_ARGARRAY_set(cx,ary) \ + (AvARRAY(MUTABLE_AV( \ + PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[ \ + CvDEPTH(cx->blk_sub.cv)]))[0] = (SV*)(ary)) +#else +# define CX_ARGARRAY(cx) (cx->blk_sub.argarray) +# define CX_ARGARRAY_set(cx,ary) (cx->blk_sub.argarray = (ary)) +#endif + + /* --- Error messages ------------------------------------------------------ */ static const char su_stack_smash[] = "Cannot target a scope outside of the current stack"; @@ -1271,7 +1298,12 @@ static void su_yield(pTHX_ void *ud_) { o = SU_RETOP_EVAL(cx2); break; #if XSH_HAS_PERL(5, 11, 0) +# if XSH_HAS_PERL(5, 23, 8) + case CXt_LOOP_ARY: + case CXt_LOOP_LIST: +# else case CXt_LOOP_FOR: +# endif case CXt_LOOP_PLAIN: case CXt_LOOP_LAZYSV: case CXt_LOOP_LAZYIV: @@ -1312,7 +1344,12 @@ static void su_yield(pTHX_ void *ud_) { next = SU_RETOP_EVAL(cx); break; #if XSH_HAS_PERL(5, 11, 0) +# if XSH_HAS_PERL(5, 23, 8) + case CXt_LOOP_ARY: + case CXt_LOOP_LIST: +# else case CXt_LOOP_FOR: +# endif case CXt_LOOP_PLAIN: case CXt_LOOP_LAZYSV: case CXt_LOOP_LAZYIV: @@ -1483,7 +1520,7 @@ static int su_uplevel_goto_runops(pTHX) { switch (CxTYPE(cx)) { case CXt_SUB: if (CxHASARGS(cx)) { - argarray = cx->blk_sub.argarray; + argarray = CX_ARGARRAY(cx); goto done; } break; @@ -1558,8 +1595,8 @@ static void su_uplevel_restore(pTHX_ void *sus_) { * reached without a goto() happening, and the old argarray member is * actually our fake argarray. Destroy it properly in that case. */ if (cx->blk_sub.cv == sud->renamed) { - SvREFCNT_dec(cx->blk_sub.argarray); - cx->blk_sub.argarray = argarray; + SvREFCNT_dec(CX_ARGARRAY(cx)); + CX_ARGARRAY_set(cx, argarray); } CvDEPTH(sud->callback)--; @@ -1863,6 +1900,7 @@ static I32 su_uplevel(pTHX_ CV *callback, I32 cxix, I32 args) { if ((PL_op = PL_ppaddr[OP_ENTERSUB](aTHX))) { PERL_CONTEXT *sub_cx = cxstack + cxstack_ix; + AV *argarray = CX_ARGARRAY(cx); /* If pp_entersub() returns a non-null OP, it means that the callback is not * an XSUB. */ @@ -1870,7 +1908,7 @@ static I32 su_uplevel(pTHX_ CV *callback, I32 cxix, I32 args) { sud->callback = MUTABLE_CV(SvREFCNT_inc(callback)); CvDEPTH(callback)++; - if (CxHASARGS(cx) && cx->blk_sub.argarray) { + if (CxHASARGS(cx) && argarray) { /* The call to pp_entersub() has saved the current @_ (in XS terms, * GvAV(PL_defgv)) in the savearray member, and has created a new argarray * with what we put on the stack. But we want to fake up the same arguments @@ -1879,12 +1917,12 @@ static I32 su_uplevel(pTHX_ CV *callback, I32 cxix, I32 args) { AV *av = newAV(); AvREAL_off(av); AvREIFY_on(av); - av_extend(av, AvMAX(cx->blk_sub.argarray)); - AvFILLp(av) = AvFILLp(cx->blk_sub.argarray); - Copy(AvARRAY(cx->blk_sub.argarray), AvARRAY(av), AvFILLp(av) + 1, SV *); - sub_cx->blk_sub.argarray = av; + av_extend(av, AvMAX(argarray)); + AvFILLp(av) = AvFILLp(argarray); + Copy(AvARRAY(argarray), AvARRAY(av), AvFILLp(av) + 1, SV *); + CX_ARGARRAY_set(sub_cx, av); } else { - SvREFCNT_inc_simple_void(sub_cx->blk_sub.argarray); + SvREFCNT_inc_simple_void(CX_ARGARRAY(sub_cx)); } if (su_uplevel_goto_static(CvROOT(renamed))) { @@ -2178,7 +2216,12 @@ static I32 su_context_gimme(pTHX_ I32 cxix) { switch (CxTYPE(cx)) { /* gimme is always G_ARRAY for loop contexts. */ #if XSH_HAS_PERL(5, 11, 0) +# if XSH_HAS_PERL(5, 23, 8) + case CXt_LOOP_ARY: + case CXt_LOOP_LIST: +# else case CXt_LOOP_FOR: +# endif case CXt_LOOP_PLAIN: case CXt_LOOP_LAZYSV: case CXt_LOOP_LAZYIV: