From: David Mitchell <davem@iabyn.com>
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/?p=perl%2Fmodules%2FScope-Upper.git;a=commitdiff_plain;h=f0ee3a495f7f12754a9e79ef83f9affc69ad2f66

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: