This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
tiearray.t - more fine-grained DESTROY counts
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 412578d..cf1399e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -853,10 +853,8 @@ Perl_op_free(pTHX_ OP *o)
 
         op_clear(o);
         FreeOp(o);
-#ifdef DEBUG_LEAKING_SCALARS
         if (PL_op == o)
             PL_op = NULL;
-#endif
     } while ( (o = POP_DEFERRED_OP()) );
 
     Safefree(defer_stack);
@@ -929,6 +927,7 @@ Perl_op_clear(pTHX_ OP *o)
         /* FALLTHROUGH */
     case OP_ENTERTRY:
     case OP_ENTEREVAL: /* Was holding hints. */
+    case OP_ARGDEFELEM:        /* Was holding signature index. */
        o->op_targ = 0;
        break;
     default:
@@ -1014,14 +1013,20 @@ Perl_op_clear(pTHX_ OP *o)
     case OP_SUBST:
        op_free(cPMOPo->op_pmreplrootu.op_pmreplroot);
        goto clear_pmop;
-    case OP_PUSHRE:
+
+    case OP_SPLIT:
+        if (     (o->op_private & OPpSPLIT_ASSIGN) /* @array  = split */
+            && !(o->op_flags & OPf_STACKED))       /* @{expr} = split */
+        {
+            if (o->op_private & OPpSPLIT_LEX)
+                pad_free(cPMOPo->op_pmreplrootu.op_pmtargetoff);
+            else
 #ifdef USE_ITHREADS
-        if (cPMOPo->op_pmreplrootu.op_pmtargetoff) {
-           pad_swipe(cPMOPo->op_pmreplrootu.op_pmtargetoff, TRUE);
-       }
+                pad_swipe(cPMOPo->op_pmreplrootu.op_pmtargetoff, TRUE);
 #else
-       SvREFCNT_dec(MUTABLE_SV(cPMOPo->op_pmreplrootu.op_pmtargetgv));
+                SvREFCNT_dec(MUTABLE_SV(cPMOPo->op_pmreplrootu.op_pmtargetgv));
 #endif
+        }
        /* FALLTHROUGH */
     case OP_MATCH:
     case OP_QR:
@@ -1052,6 +1057,10 @@ Perl_op_clear(pTHX_ OP *o)
 
        break;
 
+    case OP_ARGCHECK:
+        PerlMemShared_free(cUNOP_AUXo->op_aux);
+        break;
+
     case OP_MULTIDEREF:
         {
             UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
@@ -1221,7 +1230,7 @@ S_find_and_forget_pmops(pTHX_ OP *o)
        while (kid) {
            switch (kid->op_type) {
            case OP_SUBST:
-           case OP_PUSHRE:
+           case OP_SPLIT:
            case OP_MATCH:
            case OP_QR:
                forget_pmop((PMOP*)kid);
@@ -1488,8 +1497,8 @@ S_op_sibling_newUNOP(pTHX_ OP *parent, OP *start, I32 type, I32 flags)
  * being spread throughout this file.
  */
 
-STATIC LOGOP *
-S_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
+LOGOP *
+Perl_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
 {
     dVAR;
     LOGOP *logop;
@@ -1987,16 +1996,7 @@ Perl_scalarvoid(pTHX_ OP *arg)
             break;
 
         case OP_SPLIT:
-            kid = cLISTOPo->op_first;
-            if (kid && kid->op_type == OP_PUSHRE
-                && !kid->op_targ
-                && !(o->op_flags & OPf_STACKED)
-#ifdef USE_ITHREADS
-                && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetoff
-#else
-                && !((PMOP*)kid)->op_pmreplrootu.op_pmtargetgv
-#endif
-                )
+            if (!(o->op_private & OPpSPLIT_ASSIGN))
                 useless = OP_DESC(o);
             break;
 
@@ -2496,6 +2496,7 @@ S_finalize_op(pTHX_ OP* o)
 {
     PERL_ARGS_ASSERT_FINALIZE_OP;
 
+    assert(o->op_type != OP_FREED);
 
     switch (o->op_type) {
     case OP_NEXTSTATE:
@@ -2642,8 +2643,6 @@ S_finalize_op(pTHX_ OP* o)
               || family == OA_FILESTATOP
               || family == OA_LOOPEXOP
               || family == OA_METHOP
-              /* I don't know why SASSIGN is tagged as OA_BASEOP - DAPM */
-              || type == OP_SASSIGN
               || type == OP_CUSTOM
               || type == OP_NULL /* new_logop does this */
               );
@@ -2834,6 +2833,7 @@ S_lvref(pTHX_ OP *o, I32 type)
                      ? "do block"
                      : OP_DESC(o),
                     PL_op_desc[type]));
+       return;
     }
     OpTYPE_set(o, OP_LVREF);
     o->op_private &=
@@ -3198,8 +3198,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
                                 "feature is not enabled");
            Perl_ck_warner_d(aTHX_
                     packWARN(WARN_EXPERIMENTAL__DECLARED_REFS),
-                   "Reference constructors after declarators are "
-                   "experimental");
+                   "Declaring references is experimental");
            op_lvalue(cUNOPo->op_first, OP_NULL);
            return o;
        }
@@ -3234,16 +3233,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        return o;
 
     case OP_SPLIT:
-       kid = cLISTOPo->op_first;
-       if (kid && kid->op_type == OP_PUSHRE &&
-               (  kid->op_targ
-               || o->op_flags & OPf_STACKED
-#ifdef USE_ITHREADS
-               || ((PMOP*)kid)->op_pmreplrootu.op_pmtargetoff
-#else
-               || ((PMOP*)kid)->op_pmreplrootu.op_pmtargetgv
-#endif
-       )) {
+        if ((o->op_private & OPpSPLIT_ASSIGN)) {
            /* This is actually @array = split.  */
            PL_modcount = RETURN_UNLIMITED_NUMBER;
            break;
@@ -3255,7 +3245,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        goto nomod;
     }
 
-    /* [20011101.069] File test operators interpret OPf_REF to mean that
+    /* [20011101.069 (#7861)] File test operators interpret OPf_REF to mean that
        their argument is a filehandle; thus \stat(".") should not set
        it. AMS 20011102 */
     if (type == OP_REFGEN &&
@@ -3266,7 +3256,8 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
         o->op_flags |= OPf_MOD;
 
     if (type == OP_AASSIGN || type == OP_SASSIGN)
-       o->op_flags |= OPf_SPECIAL|OPf_REF;
+       o->op_flags |= OPf_SPECIAL
+                     |(o->op_type == OP_ENTERSUB ? 0 : OPf_REF);
     else if (!type) { /* local() */
        switch (localize) {
        case 1:
@@ -3282,7 +3273,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        }
     }
     else if (type != OP_GREPSTART && type != OP_ENTERSUB
-             && type != OP_LEAVESUBLV)
+             && type != OP_LEAVESUBLV && o->op_type != OP_ENTERSUB)
        o->op_flags |= OPf_REF;
     return o;
 }
@@ -3785,8 +3776,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
                             "feature is not enabled");
        Perl_ck_warner_d(aTHX_
             packWARN(WARN_EXPERIMENTAL__DECLARED_REFS),
-           "Reference constructors after declarators are "
-           "experimental");
+           "Declaring references is experimental");
        /* Kid is a nulled OP_LIST, handled above.  */
        my_kid(cUNOPo->op_first, attrs, imopsp);
        return o;
@@ -4381,7 +4371,7 @@ S_op_integerize(pTHX_ OP *o)
 }
 
 static OP *
-S_fold_constants(pTHX_ OP *o)
+S_fold_constants(pTHX_ OP *const o)
 {
     dVAR;
     OP * VOL curop;
@@ -4768,7 +4758,13 @@ Perl_op_convert_list(pTHX_ I32 type, I32 flags, OP *o)
        }
     }
 
-    OpTYPE_set(o, type);
+    if (type != OP_SPLIT)
+        /* At this point o is a LISTOP, but OP_SPLIT is a PMOP; let
+         * ck_split() create a real PMOP and leave the op's type as listop
+         * for now. Otherwise op_free() etc will crash.
+         */
+        OpTYPE_set(o, type);
+
     o->op_flags |= flags;
     if (flags & OPf_FOLDED)
        o->op_folded = 1;
@@ -5115,7 +5111,7 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
     BINOP *binop;
 
     ASSUME((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP
-       || type == OP_SASSIGN || type == OP_NULL || type == OP_CUSTOM);
+       || type == OP_NULL || type == OP_CUSTOM);
 
     NewOp(1101, binop, 1, BINOP);
 
@@ -5430,7 +5426,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                        tbl[i] = (short)i;
                }
                else {
-                   if (i < 128 && r[j] >= 128)
+                   if (UVCHR_IS_INVARIANT(i) && ! UVCHR_IS_INVARIANT(r[j]))
                        grows = 1;
                    tbl[i] = r[j++];
                }
@@ -5477,7 +5473,8 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                --j;
            }
            if (tbl[t[i]] == -1) {
-               if (t[i] < 128 && r[j] >= 128)
+                if (     UVCHR_IS_INVARIANT(t[i])
+                    && ! UVCHR_IS_INVARIANT(r[j]))
                    grows = 1;
                tbl[t[i]] = r[j];
            }
@@ -5596,10 +5593,12 @@ S_set_haseval(pTHX)
  * constant), or convert expr into a runtime regcomp op sequence (if it's
  * not)
  *
- * isreg indicates that the pattern is part of a regex construct, eg
+ * Flags currently has 2 bits of meaning:
+ * 1: isreg indicates that the pattern is part of a regex construct, eg
  * $x =~ /pattern/ or split /pattern/, as opposed to $x =~ $pattern or
  * split "pattern", which aren't. In the former case, expr will be a list
  * if the pattern contains more than one term (eg /a$b/).
+ * 2: The pattern is for a split.
  *
  * When the pattern has been compiled within a new anon CV (for
  * qr/(?{...})/ ), then floor indicates the savestack level just before
@@ -5607,7 +5606,7 @@ S_set_haseval(pTHX)
  */
 
 OP *
-Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor)
+Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
 {
     PMOP *pm;
     LOGOP *rcop;
@@ -5615,6 +5614,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor)
     bool is_trans = (o->op_type == OP_TRANS || o->op_type == OP_TRANSR);
     bool is_compiletime;
     bool has_code;
+    bool isreg    = cBOOL(flags & 1);
+    bool is_split = cBOOL(flags & 2);
 
     PERL_ARGS_ASSERT_PMRUNTIME;
 
@@ -5719,8 +5720,11 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor)
        U32 rx_flags = pm->op_pmflags & RXf_PMf_COMPILETIME;
        regexp_engine const *eng = current_re_engine();
 
-        if (o->op_flags & OPf_SPECIAL)
+        if (is_split) {
+            /* make engine handle split ' ' specially */
+            pm->op_pmflags |= PMf_SPLIT;
             rx_flags |= RXf_SPLIT;
+        }
 
        if (!has_code || !eng->op_comp) {
            /* compile-time simple constant pattern */
@@ -5738,7 +5742,13 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor)
                SSize_t i = 0;
                assert(PadnamelistMAXNAMED(PL_comppad_name) == 0);
                while (++i <= AvFILLp(PL_comppad)) {
+#  ifdef USE_PAD_RESET
+                    /* under USE_PAD_RESET, pad swipe replaces a swiped
+                     * folded constant with a fresh padtmp */
+                   assert(!PL_curpad[i] || SvPADTMP(PL_curpad[i]));
+#  else
                    assert(!PL_curpad[i]);
+#  endif
                }
 #endif
                /* But we know that one op is using this CV's slab. */
@@ -5803,7 +5813,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor)
            pm->op_pmflags |= PMf_CODELIST_PRIVATE;
        }
 
-        if (o->op_flags & OPf_SPECIAL)
+        if (is_split)
+            /* make engine handle split ' ' specially */
             pm->op_pmflags |= PMf_SPLIT;
 
        /* the OP_REGCMAYBE is a placeholder in the non-threaded case
@@ -5859,7 +5870,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor)
            expr = list(force_list(newUNOP(OP_ENTERSUB, 0, scalar(expr)), 1));
        }
 
-        rcop = S_alloc_LOGOP(aTHX_ OP_REGCOMP, scalar(expr), o);
+        rcop = alloc_LOGOP(OP_REGCOMP, scalar(expr), o);
        rcop->op_flags |=  ((PL_hints & HINT_RE_EVAL) ? OPf_SPECIAL : 0)
                           | (reglist ? OPf_STACKED : 0);
        rcop->op_targ = cv_targ;
@@ -5923,7 +5934,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor)
            op_prepend_elem(o->op_type, scalar(repl), o);
        }
        else {
-            rcop = S_alloc_LOGOP(aTHX_ OP_SUBSTCONT, scalar(repl), o);
+            rcop = alloc_LOGOP(OP_SUBSTCONT, scalar(repl), o);
            rcop->op_private = 1;
 
            /* establish postfix order */
@@ -6496,9 +6507,10 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 
     if (optype) {
        if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN || optype == OP_DORASSIGN) {
+            right = scalar(right);
            return newLOGOP(optype, 0,
                op_lvalue(scalar(left), optype),
-               newUNOP(OP_SASSIGN, 0, scalar(right)));
+               newBINOP(OP_SASSIGN, OPpASSIGN_BACKWARDS<<8, right, right));
        }
        else {
            return newBINOP(optype, OPf_STACKED,
@@ -6554,91 +6566,94 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                yyerror(no_list_state);
        }
 
-       if (right && right->op_type == OP_SPLIT
-        && !(right->op_flags & OPf_STACKED)) {
-           OP* tmpop = ((LISTOP*)right)->op_first;
-           PMOP * const pm = (PMOP*)tmpop;
-           assert (tmpop && (tmpop->op_type == OP_PUSHRE));
-           if (
-#ifdef USE_ITHREADS
-                   !pm->op_pmreplrootu.op_pmtargetoff
-#else
-                   !pm->op_pmreplrootu.op_pmtargetgv
-#endif
-                && !pm->op_targ
-               ) {
-                   if (!(left->op_private & OPpLVAL_INTRO) &&
-                       ( (left->op_type == OP_RV2AV &&
-                         (tmpop=((UNOP*)left)->op_first)->op_type==OP_GV)
-                       || left->op_type == OP_PADAV )
-                       ) {
-                       if (tmpop != (OP *)pm) {
+        /* optimise @a = split(...) into:
+        * @{expr}:              split(..., @{expr}) (where @a is not flattened)
+        * @a, my @a, local @a:  split(...)          (where @a is attached to
+        *                                            the split op itself)
+        */
+
+       if (   right
+            && right->op_type == OP_SPLIT
+            /* don't do twice, e.g. @b = (@a = split) */
+            && !(right->op_private & OPpSPLIT_ASSIGN))
+        {
+            OP *gvop = NULL;
+
+            if (   (  left->op_type == OP_RV2AV
+                   && (gvop=((UNOP*)left)->op_first)->op_type==OP_GV)
+                || left->op_type == OP_PADAV)
+            {
+                /* @pkg or @lex or local @pkg' or 'my @lex' */
+                OP *tmpop;
+                if (gvop) {
 #ifdef USE_ITHREADS
-                         pm->op_pmreplrootu.op_pmtargetoff
-                           = cPADOPx(tmpop)->op_padix;
-                         cPADOPx(tmpop)->op_padix = 0; /* steal it */
+                    ((PMOP*)right)->op_pmreplrootu.op_pmtargetoff
+                        = cPADOPx(gvop)->op_padix;
+                    cPADOPx(gvop)->op_padix = 0;       /* steal it */
 #else
-                         pm->op_pmreplrootu.op_pmtargetgv
-                           = MUTABLE_GV(cSVOPx(tmpop)->op_sv);
-                         cSVOPx(tmpop)->op_sv = NULL;  /* steal it */
+                    ((PMOP*)right)->op_pmreplrootu.op_pmtargetgv
+                        = MUTABLE_GV(cSVOPx(gvop)->op_sv);
+                    cSVOPx(gvop)->op_sv = NULL;        /* steal it */
 #endif
-                         right->op_private |=
-                           left->op_private & OPpOUR_INTRO;
-                       }
-                       else {
-                           pm->op_targ = left->op_targ;
-                           left->op_targ = 0; /* filch it */
-                       }
-                     detach_split:
-                       tmpop = cUNOPo->op_first;       /* to list (nulled) */
-                       tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
-                        /* detach rest of siblings from o subtree,
-                         * and free subtree */
-                        op_sibling_splice(cUNOPo->op_first, tmpop, -1, NULL);
-                       op_free(o);                     /* blow off assign */
-                       right->op_flags &= ~OPf_WANT;
-                               /* "I don't know and I don't care." */
-                       return right;
-                   }
-                   else if (left->op_type == OP_RV2AV
-                         || left->op_type == OP_PADAV)
-                   {
-                       /* Detach the array.  */
-#ifdef DEBUGGING
-                       OP * const ary =
-#endif
-                       op_sibling_splice(cBINOPo->op_last,
-                                         cUNOPx(cBINOPo->op_last)
-                                               ->op_first, 1, NULL);
-                       assert(ary == left);
-                       /* Attach it to the split.  */
-                       op_sibling_splice(right, cLISTOPx(right)->op_last,
-                                         0, left);
-                       right->op_flags |= OPf_STACKED;
-                       /* Detach split and expunge aassign as above.  */
-                       goto detach_split;
-                   }
-                   else if (PL_modcount < RETURN_UNLIMITED_NUMBER &&
-                           ((LISTOP*)right)->op_last->op_type == OP_CONST)
-                   {
-                       SV ** const svp =
-                           &((SVOP*)((LISTOP*)right)->op_last)->op_sv;
-                       SV * const sv = *svp;
-                       if (SvIOK(sv) && SvIVX(sv) == 0)
-                       {
-                         if (right->op_private & OPpSPLIT_IMPLIM) {
-                           /* our own SV, created in ck_split */
-                           SvREADONLY_off(sv);
-                           sv_setiv(sv, PL_modcount+1);
-                         }
-                         else {
-                           /* SV may belong to someone else */
-                           SvREFCNT_dec(sv);
-                           *svp = newSViv(PL_modcount+1);
-                         }
-                       }
-                   }
-           }
+                    right->op_private |=
+                        left->op_private & OPpOUR_INTRO;
+                }
+                else {
+                    ((PMOP*)right)->op_pmreplrootu.op_pmtargetoff = left->op_targ;
+                    left->op_targ = 0; /* steal it */
+                    right->op_private |= OPpSPLIT_LEX;
+                }
+                right->op_private |= left->op_private & OPpLVAL_INTRO;
+
+              detach_split:
+                tmpop = cUNOPo->op_first;      /* to list (nulled) */
+                tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
+                assert(OpSIBLING(tmpop) == right);
+                assert(!OpHAS_SIBLING(right));
+                /* detach the split subtreee from the o tree,
+                 * then free the residual o tree */
+                op_sibling_splice(cUNOPo->op_first, tmpop, 1, NULL);
+                op_free(o);                    /* blow off assign */
+                right->op_private |= OPpSPLIT_ASSIGN;
+                right->op_flags &= ~OPf_WANT;
+                        /* "I don't know and I don't care." */
+                return right;
+            }
+            else if (left->op_type == OP_RV2AV) {
+                /* @{expr} */
+
+                OP *pushop = cUNOPx(cBINOPo->op_last)->op_first;
+                assert(OpSIBLING(pushop) == left);
+                /* Detach the array ...  */
+                op_sibling_splice(cBINOPo->op_last, pushop, 1, NULL);
+                /* ... and attach it to the split.  */
+                op_sibling_splice(right, cLISTOPx(right)->op_last,
+                                  0, left);
+                right->op_flags |= OPf_STACKED;
+                /* Detach split and expunge aassign as above.  */
+                goto detach_split;
+            }
+            else if (PL_modcount < RETURN_UNLIMITED_NUMBER &&
+                    ((LISTOP*)right)->op_last->op_type == OP_CONST)
+            {
+                /* convert split(...,0) to split(..., PL_modcount+1) */
+                SV ** const svp =
+                    &((SVOP*)((LISTOP*)right)->op_last)->op_sv;
+                SV * const sv = *svp;
+                if (SvIOK(sv) && SvIVX(sv) == 0)
+                {
+                  if (right->op_private & OPpSPLIT_IMPLIM) {
+                    /* our own SV, created in ck_split */
+                    SvREADONLY_off(sv);
+                    sv_setiv(sv, PL_modcount+1);
+                  }
+                  else {
+                    /* SV may belong to someone else */
+                    SvREFCNT_dec(sv);
+                    *svp = newSViv(PL_modcount+1);
+                  }
+                }
+            }
        }
        return o;
     }
@@ -6973,9 +6988,6 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        }
     }
 
-    if (type == OP_ANDASSIGN || type == OP_ORASSIGN || type == OP_DORASSIGN)
-       other->op_private |= OPpASSIGN_BACKWARDS;  /* other is an OP_SASSIGN */
-
     /* optimize AND and OR ops that have NOTs as children */
     if (first->op_type == OP_NOT
         && (first->op_flags & OPf_KIDS)
@@ -6995,7 +7007,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
         }
     }
 
-    logop = S_alloc_LOGOP(aTHX_ type, first, LINKLIST(other));
+    logop = alloc_LOGOP(type, first, LINKLIST(other));
     logop->op_flags |= (U8)flags;
     logop->op_private = (U8)(1 | (flags >> 8));
 
@@ -7066,7 +7078,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
        live->op_folded = 1;
        return live;
     }
-    logop = S_alloc_LOGOP(aTHX_ OP_COND_EXPR, first, LINKLIST(trueop));
+    logop = alloc_LOGOP(OP_COND_EXPR, first, LINKLIST(trueop));
     logop->op_flags |= (U8)flags;
     logop->op_private = (U8)(1 | (flags >> 8));
     logop->op_next = LINKLIST(falseop);
@@ -7115,7 +7127,7 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
 
     PERL_ARGS_ASSERT_NEWRANGE;
 
-    range = S_alloc_LOGOP(aTHX_ OP_RANGE, left, LINKLIST(right));
+    range = alloc_LOGOP(OP_RANGE, left, LINKLIST(right));
     range->op_flags = OPf_KIDS;
     leftstart = LINKLIST(left);
     range->op_private = (U8)(1 | (flags >> 8));
@@ -7635,7 +7647,7 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block,
     PERL_ARGS_ASSERT_NEWGIVWHENOP;
     PERL_UNUSED_ARG(entertarg); /* used to indicate targ of lexical $_ */
 
-    enterop = S_alloc_LOGOP(aTHX_ enter_opcode, block, NULL);
+    enterop = alloc_LOGOP(enter_opcode, block, NULL);
     enterop->op_targ = 0;
     enterop->op_private = 0;
 
@@ -7986,15 +7998,14 @@ S_op_const_sv(pTHX_ const OP *o, CV *cv, bool allow_lex)
     return sv;
 }
 
-static bool
+static void
 S_already_defined(pTHX_ CV *const cv, OP * const block, OP * const o,
                        PADNAME * const name, SV ** const const_svp)
 {
     assert (cv);
     assert (o || name);
     assert (const_svp);
-    if ((!block
-        )) {
+    if (!block) {
        if (CvFLAGS(PL_compcv)) {
            /* might have had built-in attrs applied */
            const bool pureperl = !CvISXSUB(cv) && CvROOT(cv);
@@ -8010,7 +8021,7 @@ S_already_defined(pTHX_ CV *const cv, OP * const block, OP * const o,
                (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS
                  & ~(CVf_LVALUE * pureperl));
        }
-       return FALSE;
+       return;
     }
 
     /* redundant check for speed: */
@@ -8032,7 +8043,7 @@ S_already_defined(pTHX_ CV *const cv, OP * const block, OP * const o,
        CopLINE_set(PL_curcop, oldline);
     }
     SAVEFREESV(cv);
-    return TRUE;
+    return;
 }
 
 CV *
@@ -8066,7 +8077,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        outside, as in:
           my sub foo; sub { sub foo { } }
      */
-   redo:
+  redo:
     name = PadlistNAMESARRAY(CvPADLIST(outcv))[pax];
     if (PadnameOUTER(name) && PARENT_PAD_INDEX(name)) {
        pax = PARENT_PAD_INDEX(name);
@@ -8164,10 +8175,12 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                                  ps_utf8);
        /* already defined? */
        if (exists) {
-           if (S_already_defined(aTHX_ cv,block,NULL,name,&const_sv))
+           S_already_defined(aTHX_ cv, block, NULL, name, &const_sv);
+            if (block)
                cv = NULL;
            else {
-               if (attrs) goto attrs;
+               if (attrs)
+                    goto attrs;
                /* just a "sub foo;" when &foo is already defined */
                SAVEFREESV(compcv);
                goto done;
@@ -8178,6 +8191,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            reusable = TRUE;
        }
     }
+
     if (const_sv) {
        SvREFCNT_inc_simple_void_NN(const_sv);
        SvFLAGS(const_sv) |= SVs_PADTMP;
@@ -8191,7 +8205,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            CvSTASH_set(cv, PL_curstash);
            *spot = cv;
        }
-       sv_setpvs(MUTABLE_SV(cv), "");  /* prototype is "" */
+        SvPVCLEAR(MUTABLE_SV(cv));  /* prototype is "" */
        CvXSUBANY(cv).any_ptr = const_sv;
        CvXSUB(cv) = const_sv_xsub;
        CvCONST_on(cv);
@@ -8203,6 +8217,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        PL_compcv = NULL;
        goto setname;
     }
+
     /* Checking whether outcv is CvOUTSIDE(compcv) is not sufficient to
        determine whether this sub definition is in the same scope as its
        declaration.  If this sub definition is inside an inner named pack-
@@ -8215,10 +8230,10 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        CvWEAKOUTSIDE_on(compcv);
     }
     /* XXX else do we have a circular reference? */
+
     if (cv) {  /* must reuse cv in case stub is referenced elsewhere */
        /* transfer PL_compcv to cv */
-       if (block
-       ) {
+       if (block) {
            cv_flags_t preserved_flags =
                CvFLAGS(cv) & (CVf_BUILTIN_ATTRS|CVf_NAMED);
            PADLIST *const temp_padl = CvPADLIST(cv);
@@ -8247,7 +8262,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            /* inner references to compcv must be fixed up ... */
            pad_fixup_inner_anons(CvPADLIST(cv), compcv, cv);
            if (PERLDB_INTER)/* Advice debugger on the new sub. */
-             ++PL_sub_generation;
+                ++PL_sub_generation;
        }
        else {
            /* Might have had built-in attributes applied -- propagate them. */
@@ -8261,7 +8276,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        cv = compcv;
        *spot = cv;
     }
-   setname:
+
+  setname:
     CvLEXICAL_on(cv);
     if (!CvNAME_HEK(cv)) {
        if (hek) (void)share_hek_hek(hek);
@@ -8275,43 +8291,45 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
        CvNAME_HEK_set(cv, hek);
     }
-    if (const_sv) goto clone;
+
+    if (const_sv)
+        goto clone;
 
     CvFILE_set_from_cop(cv, PL_curcop);
     CvSTASH_set(cv, PL_curstash);
 
     if (ps) {
        sv_setpvn(MUTABLE_SV(cv), ps, ps_len);
-        if ( ps_utf8 ) SvUTF8_on(MUTABLE_SV(cv));
+        if (ps_utf8)
+            SvUTF8_on(MUTABLE_SV(cv));
     }
 
-    if (!block)
-       goto attrs;
-
-    /* If we assign an optree to a PVCV, then we've defined a subroutine that
-       the debugger could be able to set a breakpoint in, so signal to
-       pp_entereval that it should not throw away any saved lines at scope
-       exit.  */
-       
-    PL_breakable_sub_gen++;
-    CvROOT(cv) = block;
-    CvROOT(cv)->op_private |= OPpREFCOUNTED;
-    OpREFCNT_set(CvROOT(cv), 1);
-    /* The cv no longer needs to hold a refcount on the slab, as CvROOT
-       itself has a refcount. */
-    CvSLABBED_off(cv);
-    OpslabREFCNT_dec_padok((OPSLAB *)CvSTART(cv));
+    if (block) {
+        /* If we assign an optree to a PVCV, then we've defined a
+         * subroutine that the debugger could be able to set a breakpoint
+         * in, so signal to pp_entereval that it should not throw away any
+         * saved lines at scope exit.  */
+
+        PL_breakable_sub_gen++;
+        CvROOT(cv) = block;
+        CvROOT(cv)->op_private |= OPpREFCOUNTED;
+        OpREFCNT_set(CvROOT(cv), 1);
+        /* The cv no longer needs to hold a refcount on the slab, as CvROOT
+           itself has a refcount. */
+        CvSLABBED_off(cv);
+        OpslabREFCNT_dec_padok((OPSLAB *)CvSTART(cv));
 #ifdef PERL_DEBUG_READONLY_OPS
-    slab = (OPSLAB *)CvSTART(cv);
+        slab = (OPSLAB *)CvSTART(cv);
 #endif
-    CvSTART(cv) = start;
-    CALL_PEEP(start);
-    finalize_optree(CvROOT(cv));
-    S_prune_chain_head(&CvSTART(cv));
+        CvSTART(cv) = start;
+        CALL_PEEP(start);
+        finalize_optree(CvROOT(cv));
+        S_prune_chain_head(&CvSTART(cv));
 
-    /* now that optimizer has done its work, adjust pad values */
+        /* now that optimizer has done its work, adjust pad values */
 
-    pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB);
+        pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB);
+    }
 
   attrs:
     if (attrs) {
@@ -8333,7 +8351,9 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                sv_sethek(tmpstr, HvNAME_HEK(PL_curstash));
                sv_catpvs(tmpstr, "::");
            }
-           else sv_setpvs(tmpstr, "__ANON__::");
+           else
+                sv_setpvs(tmpstr, "__ANON__::");
+
            sv_catpvn_flags(tmpstr, PadnamePV(name)+1, PadnameLEN(name)-1,
                            PadnameUTF8(name) ? SV_CATUTF8 : SV_CATBYTES);
            (void)hv_store(GvHV(PL_DBsub), SvPVX_const(tmpstr),
@@ -8357,11 +8377,13 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        assert(CvDEPTH(outcv));
        spot = (CV **)
            &PadARRAY(PadlistARRAY(CvPADLIST(outcv))[CvDEPTH(outcv)])[pax];
-       if (reusable) cv_clone_into(clonee, *spot);
+       if (reusable)
+            cv_clone_into(clonee, *spot);
        else *spot = cv_clone(clonee);
        SvREFCNT_dec_NN(clonee);
        cv = *spot;
     }
+
     if (CvDEPTH(outcv) && !reusable && PadnameIsSTATE(name)) {
        PADOFFSET depth = CvDEPTH(outcv);
        while (--depth) {
@@ -8385,6 +8407,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     return cv;
 }
 
+
 /* _x = extended */
 CV *
 Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
@@ -8394,7 +8417,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
     const char *ps;
     STRLEN ps_len = 0; /* init it to avoid false uninit warning from icc */
     U32 ps_utf8 = 0;
-    CV *cv = NULL;
+    CV *cv = NULL;     /* the previous CV with this name, if any */
     SV *const_sv;
     const bool ec = PL_parser && PL_parser->error_count;
     /* If the subroutine has no body, no attributes, and no builtin attributes
@@ -8451,6 +8474,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
        gv = gv_fetchpvs("__ANON__::__ANON__", gv_fetch_flags, SVt_PVCV);
        has_name = FALSE;
     }
+
     if (!ec) {
         if (isGV(gv)) {
             move_proto_attr(&proto, &attrs, gv);
@@ -8477,8 +8501,12 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 
     if (ec) {
        op_free(block);
-       if (name) SvREFCNT_dec(PL_compcv);
-       else cv = PL_compcv;
+
+       if (name)
+            SvREFCNT_dec(PL_compcv);
+       else
+            cv = PL_compcv;
+
        PL_compcv = 0;
        if (name && block) {
            const char *s = strrchr(name, ':');
@@ -8498,35 +8526,37 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
     }
 
     if (!block && SvTYPE(gv) != SVt_PVGV) {
-      /* If we are not defining a new sub and the existing one is not a
-         full GV + CV... */
-      if (attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS)) {
-       /* We are applying attributes to an existing sub, so we need it
-          upgraded if it is a constant.  */
-       if (SvROK(gv) && SvTYPE(SvRV(gv)) != SVt_PVCV)
-           gv_init_pvn(gv, PL_curstash, name, namlen,
-                       SVf_UTF8 * name_is_utf8);
-      }
-      else {                   /* Maybe prototype now, and had at maximum
-                                  a prototype or const/sub ref before.  */
-       if (SvTYPE(gv) > SVt_NULL) {
-           cv_ckproto_len_flags((const CV *)gv,
-                                o ? (const GV *)cSVOPo->op_sv : NULL, ps,
-                                ps_len, ps_utf8);
-       }
-       if (!SvROK(gv)) {
-         if (ps) {
-           sv_setpvn(MUTABLE_SV(gv), ps, ps_len);
-            if ( ps_utf8 ) SvUTF8_on(MUTABLE_SV(gv));
-          }
-         else
-           sv_setiv(MUTABLE_SV(gv), -1);
-       }
+        /* If we are not defining a new sub and the existing one is not a
+           full GV + CV... */
+        if (attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS)) {
+            /* We are applying attributes to an existing sub, so we need it
+               upgraded if it is a constant.  */
+            if (SvROK(gv) && SvTYPE(SvRV(gv)) != SVt_PVCV)
+                gv_init_pvn(gv, PL_curstash, name, namlen,
+                            SVf_UTF8 * name_is_utf8);
+        }
+        else {                 /* Maybe prototype now, and had at maximum
+                                   a prototype or const/sub ref before.  */
+            if (SvTYPE(gv) > SVt_NULL) {
+                cv_ckproto_len_flags((const CV *)gv,
+                                    o ? (const GV *)cSVOPo->op_sv : NULL, ps,
+                                    ps_len, ps_utf8);
+            }
 
-       SvREFCNT_dec(PL_compcv);
-       cv = PL_compcv = NULL;
-       goto done;
-      }
+            if (!SvROK(gv)) {
+                if (ps) {
+                    sv_setpvn(MUTABLE_SV(gv), ps, ps_len);
+                    if (ps_utf8)
+                        SvUTF8_on(MUTABLE_SV(gv));
+                }
+                else
+                    sv_setiv(MUTABLE_SV(gv), -1);
+            }
+
+            SvREFCNT_dec(PL_compcv);
+            cv = PL_compcv = NULL;
+            goto done;
+        }
     }
 
     cv = (!name || (isGV(gv) && GvCVGEN(gv)))
@@ -8608,23 +8638,26 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
             cv_ckproto_len_flags(cv, gv, ps, ps_len, ps_utf8);
        /* already defined (or promised)? */
        if (exists || (isGV(gv) && GvASSUMECV(gv))) {
-           if (S_already_defined(aTHX_ cv, block, o, NULL, &const_sv))
+           S_already_defined(aTHX_ cv, block, o, NULL, &const_sv);
+            if (block)
                cv = NULL;
            else {
-               if (attrs) goto attrs;
+               if (attrs)
+                    goto attrs;
                /* just a "sub foo;" when &foo is already defined */
                SAVEFREESV(PL_compcv);
                goto done;
            }
        }
     }
+
     if (const_sv) {
        SvREFCNT_inc_simple_void_NN(const_sv);
        SvFLAGS(const_sv) |= SVs_PADTMP;
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
            cv_forget_slab(cv);
-           sv_setpvs(MUTABLE_SV(cv), "");  /* prototype is "" */
+            SvPVCLEAR(MUTABLE_SV(cv));  /* prototype is "" */
            CvXSUBANY(cv).any_ptr = const_sv;
            CvXSUB(cv) = const_sv_xsub;
            CvCONST_on(cv);
@@ -8657,10 +8690,14 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
        PL_compcv = NULL;
        goto done;
     }
+
+    /* don't copy new BEGIN CV to old BEGIN CV - RT #129099 */
+    if (name && cv && *name == 'B' && strEQ(name, "BEGIN"))
+        cv = NULL;
+
     if (cv) {                          /* must reuse cv if autoloaded */
        /* transfer PL_compcv to cv */
-       if (block
-       ) {
+       if (block) {
            cv_flags_t existing_builtin_attrs = CvFLAGS(cv) & CVf_BUILTIN_ATTRS;
            PADLIST *const temp_av = CvPADLIST(cv);
            CV *const temp_cv = CvOUTSIDE(cv);
@@ -8700,14 +8737,14 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 
            if (CvFILE(cv) && CvDYNFILE(cv)) {
                Safefree(CvFILE(cv));
-    }
+            }
            CvFILE_set_from_cop(cv, PL_curcop);
            CvSTASH_set(cv, PL_curstash);
 
            /* inner references to PL_compcv must be fixed up ... */
            pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv);
            if (PERLDB_INTER)/* Advice debugger on the new sub. */
-             ++PL_sub_generation;
+                ++PL_sub_generation;
        }
        else {
            /* Might have had built-in attributes applied -- propagate them. */
@@ -8736,8 +8773,10 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
            SvRV_set(gv, (SV *)cv);
        }
     }
+
     if (!CvHASGV(cv)) {
-       if (isGV(gv)) CvGV_set(cv, gv);
+       if (isGV(gv))
+            CvGV_set(cv, gv);
        else {
             dVAR;
            U32 hash;
@@ -8754,36 +8793,36 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 
     if (ps) {
        sv_setpvn(MUTABLE_SV(cv), ps, ps_len);
-        if ( ps_utf8 ) SvUTF8_on(MUTABLE_SV(cv));
+        if ( ps_utf8 )
+            SvUTF8_on(MUTABLE_SV(cv));
     }
 
-    if (!block)
-       goto attrs;
-
-    /* If we assign an optree to a PVCV, then we've defined a subroutine that
-       the debugger could be able to set a breakpoint in, so signal to
-       pp_entereval that it should not throw away any saved lines at scope
-       exit.  */
-       
-    PL_breakable_sub_gen++;
-    CvROOT(cv) = block;
-    CvROOT(cv)->op_private |= OPpREFCOUNTED;
-    OpREFCNT_set(CvROOT(cv), 1);
-    /* The cv no longer needs to hold a refcount on the slab, as CvROOT
-       itself has a refcount. */
-    CvSLABBED_off(cv);
-    OpslabREFCNT_dec_padok((OPSLAB *)CvSTART(cv));
+    if (block) {
+        /* If we assign an optree to a PVCV, then we've defined a
+         * subroutine that the debugger could be able to set a breakpoint
+         * in, so signal to pp_entereval that it should not throw away any
+         * saved lines at scope exit.  */
+
+        PL_breakable_sub_gen++;
+        CvROOT(cv) = block;
+        CvROOT(cv)->op_private |= OPpREFCOUNTED;
+        OpREFCNT_set(CvROOT(cv), 1);
+        /* The cv no longer needs to hold a refcount on the slab, as CvROOT
+           itself has a refcount. */
+        CvSLABBED_off(cv);
+        OpslabREFCNT_dec_padok((OPSLAB *)CvSTART(cv));
 #ifdef PERL_DEBUG_READONLY_OPS
-    slab = (OPSLAB *)CvSTART(cv);
+        slab = (OPSLAB *)CvSTART(cv);
 #endif
-    CvSTART(cv) = start;
-    CALL_PEEP(start);
-    finalize_optree(CvROOT(cv));
-    S_prune_chain_head(&CvSTART(cv));
+        CvSTART(cv) = start;
+        CALL_PEEP(start);
+        finalize_optree(CvROOT(cv));
+        S_prune_chain_head(&CvSTART(cv));
 
-    /* now that optimizer has done its work, adjust pad values */
+        /* now that optimizer has done its work, adjust pad values */
 
-    pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB);
+        pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB);
+    }
 
   attrs:
     if (attrs) {
@@ -8791,9 +8830,11 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
        HV *stash = name && !CvNAMED(cv) && GvSTASH(CvGV(cv))
                        ? GvSTASH(CvGV(cv))
                        : PL_curstash;
-       if (!name) SAVEFREESV(cv);
+       if (!name)
+            SAVEFREESV(cv);
        apply_attrs(stash, MUTABLE_SV(cv), attrs);
-       if (!name) SvREFCNT_inc_simple_void_NN(cv);
+       if (!name)
+            SvREFCNT_inc_simple_void_NN(cv);
     }
 
     if (block && has_name) {
@@ -8834,12 +8875,13 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
     if (PL_parser)
        PL_parser->copline = NOLINE;
     LEAVE_SCOPE(floor);
+
     if (!evanescent) {
 #ifdef PERL_DEBUG_READONLY_OPS
-      if (slab)
+    if (slab)
        Slab_to_ro(slab);
 #endif
-      if (cv && name && CvOUTSIDE(cv) && !CvEVAL(CvOUTSIDE(cv)))
+    if (cv && name && block && CvOUTSIDE(cv) && !CvEVAL(CvOUTSIDE(cv)))
        pad_add_weakref(cv);
     }
     return cv;
@@ -9676,7 +9718,7 @@ Perl_ck_eval(pTHX_ OP *o)
             op_sibling_splice(o, NULL, -1, NULL);
            op_free(o);
 
-            enter = S_alloc_LOGOP(aTHX_ OP_ENTERTRY, NULL, NULL);
+            enter = alloc_LOGOP(OP_ENTERTRY, NULL, NULL);
 
            /* establish postfix order */
            enter->op_next = (OP*)enter;
@@ -10120,7 +10162,7 @@ Perl_ck_fun(pTHX_ OP *o)
                                if (want_dollar && *name != '$')
                                    sv_setpvs(namesv, "$");
                                else
-                                   sv_setpvs(namesv, "");
+                                    SvPVCLEAR(namesv);
                                sv_catpvn(namesv, name, len);
                                 if ( name_utf8 ) SvUTF8_on(namesv);
                            }
@@ -10248,7 +10290,7 @@ Perl_ck_grep(pTHX_ OP *o)
        Perl_croak(aTHX_ "panic: ck_grep, type=%u", (unsigned) kid->op_type);
     kid = kUNOP->op_first;
 
-    gwop = S_alloc_LOGOP(aTHX_ type, o, LINKLIST(kid));
+    gwop = alloc_LOGOP(type, o, LINKLIST(kid));
     kid->op_next = (OP*)gwop;
     o->op_private = gwop->op_private = 0;
     gwop->op_targ = pad_alloc(type, SVs_PADTMP);
@@ -10455,7 +10497,7 @@ OP *
 Perl_ck_sassign(pTHX_ OP *o)
 {
     dVAR;
-    OP * const kid = cLISTOPo->op_first;
+    OP * const kid = cBINOPo->op_first;
 
     PERL_ARGS_ASSERT_CK_SASSIGN;
 
@@ -11089,52 +11131,76 @@ Perl_ck_split(pTHX_ OP *o)
 {
     dVAR;
     OP *kid;
+    OP *sibs;
 
     PERL_ARGS_ASSERT_CK_SPLIT;
 
+    assert(o->op_type == OP_LIST);
+
     if (o->op_flags & OPf_STACKED)
        return no_fh_allowed(o);
 
     kid = cLISTOPo->op_first;
-    if (kid->op_type != OP_NULL)
-       Perl_croak(aTHX_ "panic: ck_split, type=%u", (unsigned) kid->op_type);
     /* delete leading NULL node, then add a CONST if no other nodes */
+    assert(kid->op_type == OP_NULL);
     op_sibling_splice(o, NULL, 1,
        OpHAS_SIBLING(kid) ? NULL : newSVOP(OP_CONST, 0, newSVpvs(" ")));
     op_free(kid);
     kid = cLISTOPo->op_first;
 
     if (kid->op_type != OP_MATCH || kid->op_flags & OPf_STACKED) {
-        /* remove kid, and replace with new optree */
+        /* remove match expression, and replace with new optree with
+         * a match op at its head */
         op_sibling_splice(o, NULL, 1, NULL);
-        /* OPf_SPECIAL is used to trigger split " " behavior */
-        kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, NULL, 0, 0);
+        /* pmruntime will handle split " " behavior with flag==2 */
+        kid = pmruntime(newPMOP(OP_MATCH, 0), kid, NULL, 2, 0);
         op_sibling_splice(o, NULL, 0, kid);
     }
-    OpTYPE_set(kid, OP_PUSHRE);
-    /* target implies @ary=..., so wipe it */
-    kid->op_targ = 0;
-    scalar(kid);
+
+    assert(kid->op_type == OP_MATCH || kid->op_type == OP_SPLIT);
+
     if (((PMOP *)kid)->op_pmflags & PMf_GLOBAL) {
       Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP),
                     "Use of /g modifier is meaningless in split");
     }
 
-    if (!OpHAS_SIBLING(kid))
-       op_append_elem(OP_SPLIT, o, newDEFSVOP());
+    /* eliminate the split op, and move the match op (plus any children)
+     * into its place, then convert the match op into a split op. i.e.
+     *
+     *  SPLIT                    MATCH                 SPLIT(ex-MATCH)
+     *    |                        |                     |
+     *  MATCH - A - B - C   =>     R - A - B - C   =>    R - A - B - C
+     *    |                        |                     |
+     *    R                        X - Y                 X - Y
+     *    |
+     *    X - Y
+     *
+     * (R, if it exists, will be a regcomp op)
+     */
 
-    kid = OpSIBLING(kid);
-    assert(kid);
-    scalar(kid);
+    op_sibling_splice(o, NULL, 1, NULL); /* detach match op from o */
+    sibs = op_sibling_splice(o, NULL, -1, NULL); /* detach any other sibs */
+    op_sibling_splice(kid, cLISTOPx(kid)->op_last, 0, sibs); /* and reattach */
+    OpTYPE_set(kid, OP_SPLIT);
+    kid->op_flags   = (o->op_flags | (kid->op_flags & OPf_KIDS));
+    assert(!(kid->op_private & ~OPpRUNTIME));
+    kid->op_private = (o->op_private | (kid->op_private & OPpRUNTIME));
+    op_free(o);
+    o = kid;
+    kid = sibs; /* kid is now the string arg of the split */
 
-    if (!OpHAS_SIBLING(kid))
-    {
-       op_append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
-       o->op_private |= OPpSPLIT_IMPLIM;
+    if (!kid) {
+       kid = newDEFSVOP();
+       op_append_elem(OP_SPLIT, o, kid);
     }
-    assert(OpHAS_SIBLING(kid));
+    scalar(kid);
 
     kid = OpSIBLING(kid);
+    if (!kid) {
+        kid = newSVOP(OP_CONST, 0, newSViv(0));
+       op_append_elem(OP_SPLIT, o, kid);
+       o->op_private |= OPpSPLIT_IMPLIM;
+    }
     scalar(kid);
 
     if (OpHAS_SIBLING(kid))
@@ -11908,6 +11974,7 @@ Perl_ck_subr(pTHX_ OP *o)
        case OP_METHOD_SUPER:
        case OP_METHOD_REDIR:
        case OP_METHOD_REDIR_SUPER:
+           o->op_flags |= OPf_REF;
            if (aop->op_type == OP_CONST) {
                aop->op_private &= ~OPpCONST_STRICT;
                const_class = &cSVOPx(aop)->op_sv;
@@ -12073,6 +12140,7 @@ Perl_ck_each(pTHX_ OP *o)
                    && SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVHV  )
                   )
                    goto bad;
+                /* FALLTHROUGH */
            default:
                 qerror(Perl_mess(aTHX_
                     "Experimental %s on scalar is now forbidden",
@@ -12450,6 +12518,7 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, bool top, int *scalars_p)
     case OP_PADAV:
     case OP_PADHV:
         (*scalars_p) += 2;
+        /* if !top, could be e.g. @a[0,1] */
         if (top && (o->op_flags & OPf_REF))
             return (o->op_private & OPpLVAL_INTRO)
                 ? AAS_MY_AGG : AAS_LEX_AGG;
@@ -12470,6 +12539,7 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, bool top, int *scalars_p)
         if (cUNOPx(o)->op_first->op_type != OP_GV)
             return AAS_DANGEROUS; /* @{expr}, %{expr} */
         /* @pkg, %pkg */
+        /* if !top, could be e.g. @a[0,1] */
         if (top && (o->op_flags & OPf_REF))
             return AAS_PKG_AGG;
         return AAS_DANGEROUS;
@@ -12483,15 +12553,32 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, bool top, int *scalars_p)
         return AAS_PKG_SCALAR; /* $pkg */
 
     case OP_SPLIT:
-        if (cLISTOPo->op_first->op_type == OP_PUSHRE) {
-            /* "@foo = split... " optimises away the aassign and stores its
-             * destination array in the OP_PUSHRE that precedes it.
-             * A flattened array is always dangerous.
+        if (o->op_private & OPpSPLIT_ASSIGN) {
+            /* the assign in @a = split() has been optimised away
+             * and the @a attached directly to the split op
+             * Treat the array as appearing on the RHS, i.e.
+             *    ... = (@a = split)
+             * is treated like
+             *    ... = @a;
              */
+
+            if (o->op_flags & OPf_STACKED)
+                /* @{expr} = split() - the array expression is tacked
+                 * on as an extra child to split - process kid */
+                return S_aassign_scan(aTHX_ cLISTOPo->op_last, rhs,
+                                        top, scalars_p);
+
+            /* ... else array is directly attached to split op */
             (*scalars_p) += 2;
-            return AAS_DANGEROUS;
+            if (PL_op->op_private & OPpSPLIT_LEX)
+                return (o->op_private & OPpLVAL_INTRO)
+                    ? AAS_MY_AGG : AAS_LEX_AGG;
+            else
+                return AAS_PKG_AGG;
         }
-        break;
+        (*scalars_p)++;
+        /* other args of split can't be returned */
+        return AAS_SAFE_SCALAR;
 
     case OP_UNDEF:
         /* undef counts as a scalar on the RHS:
@@ -12948,6 +13035,13 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
             if (  (o->op_type == OP_AELEM || o->op_type == OP_HELEM)
                && PL_check[o->op_type] != Perl_ck_null)
                 return;
+            /* similarly for customised exists and delete */
+            if (  (o->op_type == OP_EXISTS)
+               && PL_check[o->op_type] != Perl_ck_exists)
+                return;
+            if (  (o->op_type == OP_DELETE)
+               && PL_check[o->op_type] != Perl_ck_delete)
+                return;
 
             if (   o->op_type != OP_AELEM
                 || (o->op_private &
@@ -13041,6 +13135,8 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
                 is_last = TRUE;
                 index_skip = action_count;
                 action |= MDEREF_FLAG_last;
+                if (index_type != MDEREF_INDEX_none)
+                    arg--;
             }
 
             if (pass)
@@ -13290,6 +13386,9 @@ Perl_rpeep(pTHX_ OP *o)
 
     if (!o || o->op_opt)
        return;
+
+    assert(o->op_type != OP_FREED);
+
     ENTER;
     SAVEOP();
     SAVEVPTR(PL_curcop);
@@ -13670,7 +13769,7 @@ Perl_rpeep(pTHX_ OP *o)
            /* XXX: We avoid setting op_seq here to prevent later calls
               to rpeep() from mistakenly concluding that optimisation
               has already occurred. This doesn't fix the real problem,
-              though (See 20010220.007). AMS 20010719 */
+              though (See 20010220.007 (#5874)). AMS 20010719 */
            /* op_seq functionality is now replaced by op_opt */
            o->op_opt = 0;
            /* FALLTHROUGH */
@@ -13858,7 +13957,7 @@ Perl_rpeep(pTHX_ OP *o)
                 if (   intro
                     && (8*sizeof(base) >
                         8*sizeof(UV)-OPpPADRANGE_COUNTSHIFT-SAVE_TIGHT_SHIFT
-                        ? base
+                        ? (Size_t)base
                         : (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT))
                         ) >
                         (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT))
@@ -14164,6 +14263,7 @@ Perl_rpeep(pTHX_ OP *o)
        case OP_DORASSIGN:
        case OP_RANGE:
        case OP_ONCE:
+       case OP_ARGDEFELEM:
            while (cLOGOP->op_other->op_type == OP_NULL)
                cLOGOP->op_other = cLOGOP->op_other->op_next;
            DEFER(cLOGOP->op_other);
@@ -15020,6 +15120,7 @@ const_av_xsub(pTHX_ CV* cv)
     XSRETURN(AvFILLp(av)+1);
 }
 
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */