Allow my \$a

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 08788ce..fdf41a7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -22,13 +22,19 @@
 /* This file contains the functions that create, manipulate and optimize
  * the OP structures that hold a compiled perl program.
  *
 /* This file contains the functions that create, manipulate and optimize
  * the OP structures that hold a compiled perl program.
  *

- * A Perl program is compiled into a tree of OPs. Each op contains
- * structural pointers (eg to its siblings and the next op in the
- * execution sequence), a pointer to the function that would execute the
- * op, plus any data specific to that op. For example, an OP_CONST op
- * points to the pp_const() function and to an SV containing the constant
- * value. When pp_const() is executed, its job is to push that SV onto the
- * stack.
+ * Note that during the build of miniperl, a temporary copy of this file
+ * is made, called opmini.c.
+ *
+ * A Perl program is compiled into a tree of OP nodes. Each op contains:
+ *  * structural OP pointers to its children and siblings (op_sibling,
+ *    op_first etc) that define the tree structure;
+ *  * execution order OP pointers (op_next, plus sometimes op_other,
+ *    op_lastop  etc) that define the execution sequence plus variants;
+ *  * a pointer to the C "pp" function that would execute the op;
+ *  * any data specific to that op.
+ * For example, an OP_CONST op points to the pp_const() function and to an
+ * SV containing the constant value. When pp_const() is executed, its job
+ * is to push that SV onto the stack.

  *
  * OPs are mainly created by the newFOO() functions, which are mainly
  * called from the parser (in perly.y) as the code is parsed. For example
  *
  * OPs are mainly created by the newFOO() functions, which are mainly
  * called from the parser (in perly.y) as the code is parsed. For example


@@ -40,11 +46,65 @@
  *     newBINOP(OP_MULTIPLY, flags, newSVREF($b), newSVREF($c))
  *  )
  *
  *     newBINOP(OP_MULTIPLY, flags, newSVREF($b), newSVREF($c))
  *  )
  *

- * Note that during the build of miniperl, a temporary copy of this file
- * is made, called opmini.c.
+ * As the parser reduces low-level rules, it creates little op subtrees;
+ * as higher-level rules are resolved, these subtrees get joined together
+ * as branches on a bigger subtree, until eventually a top-level rule like
+ * a subroutine definition is reduced, at which point there is one large
+ * parse tree left.
+ *
+ * The execution order pointers (op_next) are generated as the subtrees
+ * are joined together. Consider this sub-expression: A*B + C/D: at the
+ * point when it's just been parsed, the op tree looks like:
+ *
+ *   [+]
+ *    |
+ *   [*]------[/]
+ *    |        |
+ *    A---B    C---D
+ *
+ * with the intended execution order being:
+ *
+ *   [PREV] => A => B => [*] => C => D => [/] =>  [+] => [NEXT]
+ *
+ * At this point all the nodes' op_next pointers will have been set,
+ * except that:
+ *    * we don't know what the [NEXT] node will be yet;
+ *    * we don't know what the [PREV] node will be yet, but when it gets
+ *      created and needs its op_next set, it needs to be set to point to
+ *      A, which is non-obvious.
+ * To handle both those cases, we temporarily set the top node's
+ * op_next to point to the first node to be executed in this subtree (A in
+ * this case). This means that initially a subtree's op_next chain,
+ * starting from the top node, will visit each node in execution sequence
+ * then point back at the top node.
+ * When we embed this subtree in a larger tree, its top op_next is used
+ * to get the start node, then is set to point to its new neighbour.
+ * For example the two separate [*],A,B and [/],C,D subtrees would
+ * initially have had:
+ *   [*] => A;  A => B;  B => [*]
+ * and
+ *   [/] => C;  C => D;  D => [/]
+ * When these two subtrees were joined together to make the [+] subtree,
+ * [+]'s op_next was set to [*]'s op_next, i.e. A; then [*]'s op_next was
+ * set to point to [/]'s op_next, i.e. C.
+ *
+ * This op_next linking is done by the LINKLIST() macro and its underlying
+ * op_linklist() function. Given a top-level op, if its op_next is
+ * non-null, it's already been linked, so leave it. Otherwise link it with
+ * its children as described above, possibly recursively if any of the
+ * children have a null op_next.
+ *
+ * In summary: given a subtree, its top-level node's op_next will either
+ * be:
+ *   NULL: the subtree hasn't been LINKLIST()ed yet;
+ *   fake: points to the start op for this subtree;
+ *   real: once the subtree has been embedded into a larger tree

  */
 
 /*
  */
 
 /*

+
+Here's an older description from Larry.
+

 Perl's compiler is essentially a 3-pass compiler with interleaved phases:
 
     A bottom-up pass
 Perl's compiler is essentially a 3-pass compiler with interleaved phases:
 
     A bottom-up pass


@@ -109,6 +169,8 @@ recursive, but it's recursive on basic blocks, not on tree nodes.
 #define CALL_RPEEP(o) PL_rpeepp(aTHX_ o)
 #define CALL_OPFREEHOOK(o) if (PL_opfreehook) PL_opfreehook(aTHX_ o)
 
 #define CALL_RPEEP(o) PL_rpeepp(aTHX_ o)
 #define CALL_OPFREEHOOK(o) if (PL_opfreehook) PL_opfreehook(aTHX_ o)
 

+static const char array_passed_to_stat[] = "Array passed to stat will be coerced to a scalar";
+

 /* Used to avoid recursion through the op tree in scalarvoid() and
    op_free()
 */
 /* Used to avoid recursion through the op tree in scalarvoid() and
    op_free()
 */


@@ -594,7 +656,7 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
        !(is_our ||
          isALPHA(name[1]) ||
          ((flags & SVf_UTF8) && isIDFIRST_utf8((U8 *)name+1)) ||
        !(is_our ||
          isALPHA(name[1]) ||
          ((flags & SVf_UTF8) && isIDFIRST_utf8((U8 *)name+1)) ||

-         (name[1] == '_' && (*name == '$' || len > 2))))
+         (name[1] == '_' && len > 2)))

     {
        if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
         && isASCII(name[1])
     {
        if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
         && isASCII(name[1])


@@ -607,13 +669,6 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
                              PL_parser->in_my == KEY_state ? "state" : "my"), flags & SVf_UTF8);
        }
     }
                              PL_parser->in_my == KEY_state ? "state" : "my"), flags & SVf_UTF8);
        }
     }

-    else if (len == 2 && name[1] == '_' && !is_our)
-       /* diag_listed_as: Use of my $_ is experimental */
-       Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__LEXICAL_TOPIC),
-                             "Use of %s $_ is experimental",
-                              PL_parser->in_my == KEY_state
-                                ? "state"
-                                : "my");

 
     /* allocate a spare slot and store the name in that slot */
 
 
     /* allocate a spare slot and store the name in that slot */
 


@@ -719,10 +774,23 @@ Perl_op_free(pTHX_ OP *o)
         type = o->op_type;
 
         /* an op should only ever acquire op_private flags that we know about.
         type = o->op_type;
 
         /* an op should only ever acquire op_private flags that we know about.

-         * If this fails, you may need to fix something in regen/op_private */
-        if (o->op_ppaddr == PL_ppaddr[o->op_type]) {
+         * If this fails, you may need to fix something in regen/op_private.
+         * Don't bother testing if:
+         *   * the op_ppaddr doesn't match the op; someone may have
+         *     overridden the op and be doing strange things with it;
+         *   * we've errored, as op flags are often left in an
+         *     inconsistent state then. Note that an error when
+         *     compiling the main program leaves PL_parser NULL, so
+         *     we can't spot faults in the main code, only
+         *     evaled/required code */
+#ifdef DEBUGGING
+        if (   o->op_ppaddr == PL_ppaddr[o->op_type]
+            && PL_parser
+            && !PL_parser->error_count)
+        {

             assert(!(o->op_private & ~PL_op_private_valid[type]));
         }
             assert(!(o->op_private & ~PL_op_private_valid[type]));
         }

+#endif

 
         if (o->op_private & OPpREFCOUNTED) {
             switch (type) {
 
         if (o->op_private & OPpREFCOUNTED) {
             switch (type) {


@@ -796,6 +864,7 @@ Perl_op_free(pTHX_ OP *o)
 
 /* S_op_clear_gv(): free a GV attached to an OP */
 
 
 /* S_op_clear_gv(): free a GV attached to an OP */
 

+STATIC

 #ifdef USE_ITHREADS
 void S_op_clear_gv(pTHX_ OP *o, PADOFFSET *ixp)
 #else
 #ifdef USE_ITHREADS
 void S_op_clear_gv(pTHX_ OP *o, PADOFFSET *ixp)
 #else


@@ -1188,6 +1257,7 @@ Perl_op_null(pTHX_ OP *o)
 
 void
 Perl_op_refcnt_lock(pTHX)
 
 void
 Perl_op_refcnt_lock(pTHX)

+  PERL_TSA_ACQUIRE(PL_op_mutex)

 {
 #ifdef USE_ITHREADS
     dVAR;
 {
 #ifdef USE_ITHREADS
     dVAR;


@@ -1198,6 +1268,7 @@ Perl_op_refcnt_lock(pTHX)
 
 void
 Perl_op_refcnt_unlock(pTHX)
 
 void
 Perl_op_refcnt_unlock(pTHX)

+  PERL_TSA_RELEASE(PL_op_mutex)

 {
 #ifdef USE_ITHREADS
     dVAR;
 {
 #ifdef USE_ITHREADS
     dVAR;


@@ -1399,7 +1470,7 @@ Perl_op_parent(OP *o)
  * Returns the new UNOP.
  */
 
  * Returns the new UNOP.
  */
 

-OP *
+STATIC OP *

 S_op_sibling_newUNOP(pTHX_ OP *parent, OP *start, I32 type, I32 flags)
 {
     OP *kid, *newop;
 S_op_sibling_newUNOP(pTHX_ OP *parent, OP *start, I32 type, I32 flags)
 {
     OP *kid, *newop;


@@ -1417,7 +1488,7 @@ S_op_sibling_newUNOP(pTHX_ OP *parent, OP *start, I32 type, I32 flags)
  * being spread throughout this file.
  */
 
  * being spread throughout this file.
  */
 

-LOGOP *
+STATIC LOGOP *

 S_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
 {
     dVAR;
 S_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
 {
     dVAR;


@@ -1521,8 +1592,11 @@ S_scalarboolean(pTHX_ OP *o)
 {
     PERL_ARGS_ASSERT_SCALARBOOLEAN;
 
 {
     PERL_ARGS_ASSERT_SCALARBOOLEAN;
 

-    if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST
-     && !(cBINOPo->op_first->op_flags & OPf_SPECIAL)) {
+    if ((o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST &&
+         !(cBINOPo->op_first->op_flags & OPf_SPECIAL)) ||
+        (o->op_type == OP_NOT     && cUNOPo->op_first->op_type == OP_SASSIGN &&
+         cBINOPx(cUNOPo->op_first)->op_first->op_type == OP_CONST &&
+         !(cBINOPx(cUNOPo->op_first)->op_first->op_flags & OPf_SPECIAL))) {

        if (ckWARN(WARN_SYNTAX)) {
            const line_t oldline = CopLINE(PL_curcop);
 
        if (ckWARN(WARN_SYNTAX)) {
            const line_t oldline = CopLINE(PL_curcop);
 


@@ -1539,7 +1613,7 @@ S_scalarboolean(pTHX_ OP *o)
 }
 
 static SV *
 }
 
 static SV *

-S_op_varname(pTHX_ const OP *o)
+S_op_varname_subscript(pTHX_ const OP *o, int subscript_type)

 {
     assert(o);
     assert(o->op_type == OP_PADAV || o->op_type == OP_RV2AV ||
 {
     assert(o);
     assert(o->op_type == OP_PADAV || o->op_type == OP_RV2AV ||


@@ -1552,13 +1626,19 @@ S_op_varname(pTHX_ const OP *o)
            if (cUNOPo->op_first->op_type != OP_GV
             || !(gv = cGVOPx_gv(cUNOPo->op_first)))
                return NULL;
            if (cUNOPo->op_first->op_type != OP_GV
             || !(gv = cGVOPx_gv(cUNOPo->op_first)))
                return NULL;

-           return varname(gv, funny, 0, NULL, 0, 1);
+           return varname(gv, funny, 0, NULL, 0, subscript_type);

        }
        return
        }
        return

-           varname(MUTABLE_GV(PL_compcv), funny, o->op_targ, NULL, 0, 1);
+           varname(MUTABLE_GV(PL_compcv), funny, o->op_targ, NULL, 0, subscript_type);

     }
 }
 
     }
 }
 

+static SV *
+S_op_varname(pTHX_ const OP *o)
+{
+    return S_op_varname_subscript(aTHX_ o, 1);
+}
+

 static void
 S_op_pretty(pTHX_ const OP *o, SV **retsv, const char **retpv)
 { /* or not so pretty :-) */
 static void
 S_op_pretty(pTHX_ const OP *o, SV **retsv, const char **retpv)
 { /* or not so pretty :-) */


@@ -2295,7 +2375,7 @@ S_modkids(pTHX_ OP *o, I32 type)
  * key_op is the first key
  */
 
  * key_op is the first key
  */
 

-void
+STATIC void

 S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op)
 {
     PADNAME *lexname;
 S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op)
 {
     PADNAME *lexname;


@@ -2335,6 +2415,13 @@ S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op)
             continue;
         svp = cSVOPx_svp(key_op);
 
             continue;
         svp = cSVOPx_svp(key_op);
 

+        /* make sure it's not a bareword under strict subs */
+        if (key_op->op_private & OPpCONST_BARE &&
+            key_op->op_private & OPpCONST_STRICT)
+        {
+            no_bareword_allowed((OP*)key_op);
+        }
+

         /* Make the CONST have a shared SV */
         if (   !SvIsCOW_shared_hash(sv = *svp)
             && SvTYPE(sv) < SVt_PVMG
         /* Make the CONST have a shared SV */
         if (   !SvIsCOW_shared_hash(sv = *svp)
             && SvTYPE(sv) < SVt_PVMG


@@ -2606,7 +2693,13 @@ S_mark_padname_lvalue(pTHX_ PADNAME *pn)
     PadnameLVALUE_on(pn);
     while (PadnameOUTER(pn) && PARENT_PAD_INDEX(pn)) {
        cv = CvOUTSIDE(cv);
     PadnameLVALUE_on(pn);
     while (PadnameOUTER(pn) && PARENT_PAD_INDEX(pn)) {
        cv = CvOUTSIDE(cv);

-       assert(cv);
+        /* RT #127786: cv can be NULL due to an eval within the DB package
+         * called from an anon sub - anon subs don't have CvOUTSIDE() set
+         * unless they contain an eval, but calling eval within DB
+         * pretends the eval was done in the caller's scope.
+         */
+       if (!cv)
+            break;

        assert(CvPADLIST(cv));
        pn =
           PadlistNAMESARRAY(CvPADLIST(cv))[PARENT_PAD_INDEX(pn)];
        assert(CvPADLIST(cv));
        pn =
           PadlistNAMESARRAY(CvPADLIST(cv))[PARENT_PAD_INDEX(pn)];


@@ -2711,7 +2804,7 @@ S_lvref(pTHX_ OP *o, I32 type)
     case OP_ASLICE:
     case OP_HSLICE:
         OpTYPE_set(o, OP_LVREFSLICE);
     case OP_ASLICE:
     case OP_HSLICE:
         OpTYPE_set(o, OP_LVREFSLICE);

-       o->op_private &= OPpLVAL_INTRO|OPpLVREF_ELEM;
+       o->op_private &= OPpLVAL_INTRO;

        return;
     case OP_NULL:
        if (o->op_flags & OPf_SPECIAL)          /* do BLOCK */
        return;
     case OP_NULL:
        if (o->op_flags & OPf_SPECIAL)          /* do BLOCK */


@@ -2749,6 +2842,14 @@ S_lvref(pTHX_ OP *o, I32 type)
        o->op_private |= OPpLVREF_ITER;
 }
 
        o->op_private |= OPpLVREF_ITER;
 }
 

+PERL_STATIC_INLINE bool
+S_potential_mod_type(I32 type)
+{
+    /* Types that only potentially result in modification.  */
+    return type == OP_GREPSTART || type == OP_ENTERSUB
+       || type == OP_REFGEN    || type == OP_LEAVESUBLV;
+}
+

 OP *
 Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 {
 OP *
 Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 {


@@ -2789,9 +2890,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        else {                          /* lvalue subroutine call */
            o->op_private |= OPpLVAL_INTRO;
            PL_modcount = RETURN_UNLIMITED_NUMBER;
        else {                          /* lvalue subroutine call */
            o->op_private |= OPpLVAL_INTRO;
            PL_modcount = RETURN_UNLIMITED_NUMBER;

-           if (type == OP_GREPSTART || type == OP_ENTERSUB
-            || type == OP_REFGEN    || type == OP_LEAVESUBLV) {
-               /* Potential lvalue context: */
+           if (S_potential_mod_type(type)) {

                o->op_private |= OPpENTERSUB_INARGS;
                break;
            }
                o->op_private |= OPpENTERSUB_INARGS;
                break;
            }


@@ -2799,6 +2898,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
                OP *kid = cUNOPo->op_first;
                CV *cv;
                GV *gv;
                OP *kid = cUNOPo->op_first;
                CV *cv;
                GV *gv;

+                SV *namesv;

 
                if (kid->op_type != OP_PUSHMARK) {
                    if (kid->op_type != OP_NULL || kid->op_targ != OP_LIST)
 
                if (kid->op_type != OP_PUSHMARK) {
                    if (kid->op_type != OP_NULL || kid->op_targ != OP_LIST)


@@ -2836,6 +2936,15 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
                    break;
                if (CvLVALUE(cv))
                    break;
                    break;
                if (CvLVALUE(cv))
                    break;

+                if (flags & OP_LVALUE_NO_CROAK)
+                    return NULL;
+
+                namesv = cv_name(cv, NULL, 0);
+                yyerror_pv(Perl_form(aTHX_ "Can't modify non-lvalue "
+                                     "subroutine call of &%"SVf" in %s",
+                                     SVfARG(namesv), PL_op_desc[type]),
+                           SvUTF8(namesv));
+                return o;

            }
        }
        /* FALLTHROUGH */
            }
        }
        /* FALLTHROUGH */


@@ -2843,15 +2952,12 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
       nomod:
        if (flags & OP_LVALUE_NO_CROAK) return NULL;
        /* grep, foreach, subcalls, refgen */
       nomod:
        if (flags & OP_LVALUE_NO_CROAK) return NULL;
        /* grep, foreach, subcalls, refgen */

-       if (type == OP_GREPSTART || type == OP_ENTERSUB
-        || type == OP_REFGEN    || type == OP_LEAVESUBLV)
+       if (S_potential_mod_type(type))

            break;
        yyerror(Perl_form(aTHX_ "Can't modify %s in %s",
                     (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
                      ? "do block"
            break;
        yyerror(Perl_form(aTHX_ "Can't modify %s in %s",
                     (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
                      ? "do block"

-                     : (o->op_type == OP_ENTERSUB
-                       ? "non-lvalue subroutine call"
-                       : OP_DESC(o))),
+                     : OP_DESC(o)),

                     type ? PL_op_desc[type] : "local"));
        return o;
 
                     type ? PL_op_desc[type] : "local"));
        return o;
 


@@ -2939,9 +3045,15 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        break;
     case OP_KVHSLICE:
     case OP_KVASLICE:
        break;
     case OP_KVHSLICE:
     case OP_KVASLICE:

+    case OP_AKEYS:

        if (type == OP_LEAVESUBLV)
            o->op_private |= OPpMAYBE_LVSUB;
         goto nomod;
        if (type == OP_LEAVESUBLV)
            o->op_private |= OPpMAYBE_LVSUB;
         goto nomod;

+    case OP_AVHVSWITCH:
+       if (type == OP_LEAVESUBLV
+        && (o->op_private & 3) + OP_EACH == OP_KEYS)
+           o->op_private |= OPpMAYBE_LVSUB;
+        goto nomod;

     case OP_AV2ARYLEN:
        PL_hints |= HINT_BLOCK_SCOPE;
        if (type == OP_LEAVESUBLV)
     case OP_AV2ARYLEN:
        PL_hints |= HINT_BLOCK_SCOPE;
        if (type == OP_LEAVESUBLV)


@@ -2995,7 +3107,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        break;
 
     case OP_KEYS:
        break;
 
     case OP_KEYS:

-       if (type != OP_SASSIGN && type != OP_LEAVESUBLV)
+       if (type != OP_LEAVESUBLV && !scalar_mod_type(NULL, type))

            goto nomod;
        goto lvalue_func;
     case OP_SUBSTR:
            goto nomod;
        goto lvalue_func;
     case OP_SUBSTR:


@@ -3007,8 +3119,18 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
       lvalue_func:
        if (type == OP_LEAVESUBLV)
            o->op_private |= OPpMAYBE_LVSUB;
       lvalue_func:
        if (type == OP_LEAVESUBLV)
            o->op_private |= OPpMAYBE_LVSUB;

-       if (o->op_flags & OPf_KIDS)
-           op_lvalue(OpSIBLING(cBINOPo->op_first), type);
+       if (o->op_flags & OPf_KIDS && OpHAS_SIBLING(cBINOPo->op_first)) {
+           /* substr and vec */
+           /* If this op is in merely potential (non-fatal) modifiable
+              context, then apply OP_ENTERSUB context to
+              the kid op (to avoid croaking).  Other-
+              wise pass this op’s own type so the correct op is mentioned
+              in error messages.  */
+           op_lvalue(OpSIBLING(cBINOPo->op_first),
+                     S_potential_mod_type(type)
+                       ? (I32)OP_ENTERSUB
+                       : o->op_type);
+       }

        break;
 
     case OP_AELEM:
        break;
 
     case OP_AELEM:


@@ -3069,6 +3191,11 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        goto nomod;
 
     case OP_SREFGEN:
        goto nomod;
 
     case OP_SREFGEN:

+       if (type == OP_NULL) { /* local */
+         local_refgen:
+           op_lvalue(cUNOPo->op_first, OP_NULL);
+           return o;
+       }

        if (type != OP_AASSIGN && type != OP_SASSIGN
         && type != OP_ENTERLOOP)
            goto nomod;
        if (type != OP_AASSIGN && type != OP_SASSIGN
         && type != OP_ENTERLOOP)
            goto nomod;


@@ -3077,6 +3204,8 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        assert (!OpHAS_SIBLING(kid));
        goto kid_2lvref;
     case OP_REFGEN:
        assert (!OpHAS_SIBLING(kid));
        goto kid_2lvref;
     case OP_REFGEN:

+       if (type == OP_NULL) /* local */
+           goto local_refgen;

        if (type != OP_AASSIGN) goto nomod;
        kid = cUNOPo->op_first;
       kid_2lvref:
        if (type != OP_AASSIGN) goto nomod;
        kid = cUNOPo->op_first;
       kid_2lvref:


@@ -3185,6 +3314,12 @@ S_scalar_mod_type(const OP *o, I32 type)
     case OP_BIT_AND:
     case OP_BIT_XOR:
     case OP_BIT_OR:
     case OP_BIT_AND:
     case OP_BIT_XOR:
     case OP_BIT_OR:

+    case OP_NBIT_AND:
+    case OP_NBIT_XOR:
+    case OP_NBIT_OR:
+    case OP_SBIT_AND:
+    case OP_SBIT_XOR:
+    case OP_SBIT_OR:

     case OP_CONCAT:
     case OP_SUBST:
     case OP_TRANS:
     case OP_CONCAT:
     case OP_SUBST:
     case OP_TRANS:


@@ -3195,6 +3330,8 @@ S_scalar_mod_type(const OP *o, I32 type)
     case OP_ANDASSIGN:
     case OP_ORASSIGN:
     case OP_DORASSIGN:
     case OP_ANDASSIGN:
     case OP_ORASSIGN:
     case OP_DORASSIGN:

+    case OP_VEC:
+    case OP_SUBSTR:

        return TRUE;
     default:
        return FALSE;
        return TRUE;
     default:
        return FALSE;


@@ -3609,7 +3746,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
 
     type = o->op_type;
 
 
     type = o->op_type;
 

-    if (type == OP_LIST) {
+    if (OP_TYPE_IS_OR_WAS(o, OP_LIST)) {

         OP *kid;
         for (kid = cLISTOPo->op_first; kid; kid = OpSIBLING(kid))
            my_kid(kid, attrs, imopsp);
         OP *kid;
         for (kid = cLISTOPo->op_first; kid; kid = OpSIBLING(kid))
            my_kid(kid, attrs, imopsp);


@@ -3618,7 +3755,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
        return o;
     } else if (type == OP_RV2SV ||     /* "our" declaration */
               type == OP_RV2AV ||
        return o;
     } else if (type == OP_RV2SV ||     /* "our" declaration */
               type == OP_RV2AV ||

-              type == OP_RV2HV) { /* XXX does this let anything illegal in? */
+              type == OP_RV2HV) {

        if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */
            S_cant_declare(aTHX_ o);
        } else if (attrs) {
        if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */
            S_cant_declare(aTHX_ o);
        } else if (attrs) {


@@ -3635,6 +3772,11 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
        o->op_private |= OPpOUR_INTRO;
        return o;
     }
        o->op_private |= OPpOUR_INTRO;
        return o;
     }

+    else if (type == OP_REFGEN || type == OP_SREFGEN) {
+       /* Kid is a nulled OP_LIST, handled above.  */
+       my_kid(cUNOPo->op_first, attrs, imopsp);
+       return o;
+    }

     else if (type != OP_PADSV &&
             type != OP_PADAV &&
             type != OP_PADHV &&
     else if (type != OP_PADSV &&
             type != OP_PADAV &&
             type != OP_PADHV &&


@@ -4032,7 +4174,7 @@ Perl_newPROG(pTHX_ OP *o)
                               ((PL_in_eval & EVAL_KEEPERR)
                                ? OPf_SPECIAL : 0), o);
 
                               ((PL_in_eval & EVAL_KEEPERR)
                                ? OPf_SPECIAL : 0), o);
 

-       cx = &cxstack[cxstack_ix];
+       cx = CX_CUR();

        assert(CxTYPE(cx) == CXt_EVAL);
 
        if ((cx->blk_gimme & G_WANT) == G_VOID)
        assert(CxTYPE(cx) == CXt_EVAL);
 
        if ((cx->blk_gimme & G_WANT) == G_VOID)


@@ -4140,7 +4282,8 @@ Perl_localize(pTHX_ OP *o, I32 lex)
                s++;
 
            while (1) {
                s++;
 
            while (1) {

-               if (*s && strchr("@$%*", *s) && *++s
+               if (*s && (strchr("@$%", *s) || (!lex && *s == '*'))
+                      && *++s

                       && (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s))) {
                    s++;
                    sigil = TRUE;
                       && (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s))) {
                    s++;
                    sigil = TRUE;


@@ -4233,12 +4376,12 @@ S_fold_constants(pTHX_ OP *o)
     bool is_stringify;
     SV * VOL sv = NULL;
     int ret = 0;
     bool is_stringify;
     SV * VOL sv = NULL;
     int ret = 0;

-    I32 oldscope;

     OP *old_next;
     SV * const oldwarnhook = PL_warnhook;
     SV * const olddiehook  = PL_diehook;
     COP not_compiling;
     U8 oldwarn = PL_dowarn;
     OP *old_next;
     SV * const oldwarnhook = PL_warnhook;
     SV * const olddiehook  = PL_diehook;
     COP not_compiling;
     U8 oldwarn = PL_dowarn;

+    I32 old_cxix;

     dJMPENV;
 
     PERL_ARGS_ASSERT_FOLD_CONSTANTS;
     dJMPENV;
 
     PERL_ARGS_ASSERT_FOLD_CONSTANTS;


@@ -4303,13 +4446,23 @@ S_fold_constants(pTHX_ OP *o)
        goto nope;              /* Don't try to run w/ errors */
 
     for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
        goto nope;              /* Don't try to run w/ errors */
 
     for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {

-       const OPCODE type = curop->op_type;
-       if ((type != OP_CONST || (curop->op_private & OPpCONST_BARE)) &&
-           type != OP_LIST &&
-           type != OP_SCALAR &&
-           type != OP_NULL &&
-           type != OP_PUSHMARK)
-       {
+        switch (curop->op_type) {
+        case OP_CONST:
+            if (   (curop->op_private & OPpCONST_BARE)
+                && (curop->op_private & OPpCONST_STRICT)) {
+                no_bareword_allowed(curop);
+                goto nope;
+            }
+            /* FALLTHROUGH */
+        case OP_LIST:
+        case OP_SCALAR:
+        case OP_NULL:
+        case OP_PUSHMARK:
+            /* Foldable; move to next op in list */
+            break;
+
+        default:
+            /* No other op types are considered foldable */

            goto nope;
        }
     }
            goto nope;
        }
     }


@@ -4319,8 +4472,8 @@ S_fold_constants(pTHX_ OP *o)
     o->op_next = 0;
     PL_op = curop;
 
     o->op_next = 0;
     PL_op = curop;
 

-    oldscope = PL_scopestack_ix;
-    create_eval_scope(G_FAKINGEVAL);
+    old_cxix = cxstack_ix;
+    create_eval_scope(NULL, G_FAKINGEVAL);

 
     /* Verify that we don't need to save it:  */
     assert(PL_curcop == &PL_compiling);
 
     /* Verify that we don't need to save it:  */
     assert(PL_curcop == &PL_compiling);


@@ -4371,9 +4524,13 @@ S_fold_constants(pTHX_ OP *o)
     PL_diehook  = olddiehook;
     PL_curcop = &PL_compiling;
 
     PL_diehook  = olddiehook;
     PL_curcop = &PL_compiling;
 

-    if (PL_scopestack_ix > oldscope)
-       delete_eval_scope();
-
+    /* if we croaked, depending on how we croaked the eval scope
+     * may or may not have already been popped */
+    if (cxstack_ix > old_cxix) {
+        assert(cxstack_ix == old_cxix + 1);
+        assert(CxTYPE(CX_CUR()) == CXt_EVAL);
+        delete_eval_scope();
+    }

     if (ret)
        goto nope;
 
     if (ret)
        goto nope;
 


@@ -5193,7 +5350,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                    max = rfirst + diff;
                if (!grows)
                    grows = (tfirst < rfirst &&
                    max = rfirst + diff;
                if (!grows)
                    grows = (tfirst < rfirst &&

-                            UNISKIP(tfirst) < UNISKIP(rfirst + diff));
+                            UVCHR_SKIP(tfirst) < UVCHR_SKIP(rfirst + diff));

                rfirst += diff + 1;
            }
            tfirst += diff + 1;
                rfirst += diff + 1;
            }
            tfirst += diff + 1;


@@ -5809,9 +5966,7 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
 /*
 =for apidoc Am|OP *|newDEFSVOP|
 
 /*
 =for apidoc Am|OP *|newDEFSVOP|
 

-Constructs and returns an op to access C<$_>, either as a lexical
-variable (if declared as C<my $_>) in the current scope, or the
-global C<$_>.
+Constructs and returns an op to access C<$_>.

 
 =cut
 */
 
 =cut
 */


@@ -5819,15 +5974,7 @@ global C<$_>.
 OP *
 Perl_newDEFSVOP(pTHX)
 {
 OP *
 Perl_newDEFSVOP(pTHX)
 {

-    const PADOFFSET offset = pad_findmy_pvs("$_", 0);
-    if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {

        return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
        return newSVREF(newGVOP(OP_GV, 0, PL_defgv));

-    }
-    else {
-       OP * const o = newOP(OP_PADSV, 0);
-       o->op_targ = offset;
-       return o;
-    }

 }
 
 #ifdef USE_ITHREADS
 }
 
 #ifdef USE_ITHREADS


@@ -6714,24 +6861,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        || type == OP_CUSTOM);
 
     scalarboolean(first);
        || type == OP_CUSTOM);
 
     scalarboolean(first);

-    /* optimize AND and OR ops that have NOTs as children */
-    if (first->op_type == OP_NOT
-       && (first->op_flags & OPf_KIDS)
-       && ((first->op_flags & OPf_SPECIAL) /* unless ($x) { } */
-           || (other->op_type == OP_NOT))  /* if (!$x && !$y) { } */
-       ) {
-       if (type == OP_AND || type == OP_OR) {
-           if (type == OP_AND)
-               type = OP_OR;
-           else
-               type = OP_AND;
-           op_null(first);
-           if (other->op_type == OP_NOT) { /* !a AND|OR !b => !(a OR|AND b) */
-               op_null(other);
-               prepend_not = 1; /* prepend a NOT op later */
-           }
-       }
-    }
+

     /* search for a constant op that could let us fold the test */
     if ((cstop = search_const(first))) {
        if (cstop->op_private & OPpCONST_STRICT)
     /* search for a constant op that could let us fold the test */
     if ((cstop = search_const(first))) {
        if (cstop->op_private & OPpCONST_STRICT)


@@ -6741,6 +6871,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        if ((type == OP_AND &&  SvTRUE(((SVOP*)cstop)->op_sv)) ||
            (type == OP_OR  && !SvTRUE(((SVOP*)cstop)->op_sv)) ||
            (type == OP_DOR && !SvOK(((SVOP*)cstop)->op_sv))) {
        if ((type == OP_AND &&  SvTRUE(((SVOP*)cstop)->op_sv)) ||
            (type == OP_OR  && !SvTRUE(((SVOP*)cstop)->op_sv)) ||
            (type == OP_DOR && !SvOK(((SVOP*)cstop)->op_sv))) {

+            /* Elide the (constant) lhs, since it can't affect the outcome */

            *firstp = NULL;
            if (other->op_type == OP_CONST)
                other->op_private |= OPpCONST_SHORTCIRCUIT;
            *firstp = NULL;
            if (other->op_type == OP_CONST)
                other->op_private |= OPpCONST_SHORTCIRCUIT;


@@ -6758,6 +6889,9 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
            return other;
        }
        else {
            return other;
        }
        else {

+            /* Elide the rhs, since the outcome is entirely determined by
+             * the (constant) lhs */
+

            /* check for C<my $x if 0>, or C<my($x,$y) if 0> */
            const OP *o2 = other;
            if ( ! (o2->op_type == OP_LIST
            /* check for C<my $x if 0>, or C<my($x,$y) if 0> */
            const OP *o2 = other;
            if ( ! (o2->op_type == OP_LIST


@@ -6778,7 +6912,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
            *otherp = NULL;
            if (cstop->op_type == OP_CONST)
                cstop->op_private |= OPpCONST_SHORTCIRCUIT;
            *otherp = NULL;
            if (cstop->op_type == OP_CONST)
                cstop->op_private |= OPpCONST_SHORTCIRCUIT;

-               op_free(other);
+            op_free(other);

            return first;
        }
     }
            return first;
        }
     }


@@ -6825,12 +6959,28 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        }
     }
 
        }
     }
 

-    if (!other)
-       return first;
-

     if (type == OP_ANDASSIGN || type == OP_ORASSIGN || type == OP_DORASSIGN)
        other->op_private |= OPpASSIGN_BACKWARDS;  /* other is an OP_SASSIGN */
 
     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)
+        && ((first->op_flags & OPf_SPECIAL) /* unless ($x) { } */
+            || (other->op_type == OP_NOT))  /* if (!$x && !$y) { } */
+        ) {
+        if (type == OP_AND || type == OP_OR) {
+            if (type == OP_AND)
+                type = OP_OR;
+            else
+                type = OP_AND;
+            op_null(first);
+            if (other->op_type == OP_NOT) { /* !a AND|OR !b => !(a OR|AND b) */
+                op_null(other);
+                prepend_not = 1; /* prepend a NOT op later */
+            }
+        }
+    }
+

     logop = S_alloc_LOGOP(aTHX_ type, first, LINKLIST(other));
     logop->op_flags |= (U8)flags;
     logop->op_private = (U8)(1 | (flags >> 8));
     logop = S_alloc_LOGOP(aTHX_ type, first, LINKLIST(other));
     logop->op_flags |= (U8)flags;
     logop->op_private = (U8)(1 | (flags >> 8));


@@ -7086,7 +7236,7 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
 
     o->op_flags |= flags;
     o = op_scope(o);
 
     o->op_flags |= flags;
     o = op_scope(o);

-    o->op_flags |= OPf_SPECIAL;        /* suppress POPBLOCK curpm restoration*/
+    o->op_flags |= OPf_SPECIAL;        /* suppress cx_popblock() curpm restoration*/

     return o;
 }
 
     return o;
 }
 


@@ -7224,7 +7374,7 @@ loop (iteration through a list of values).  This is a heavyweight loop,
 with structure that allows exiting the loop by C<last> and suchlike.
 
 C<sv> optionally supplies the variable that will be aliased to each
 with structure that allows exiting the loop by C<last> and suchlike.
 
 C<sv> optionally supplies the variable that will be aliased to each

-item in turn; if null, it defaults to C<$_> (either lexical or global).
+item in turn; if null, it defaults to C<$_>.

 C<expr> supplies the list of values to iterate over.  C<block> supplies
 the main body of the loop, and C<cont> optionally supplies a C<continue>
 block that operates as a second half of the body.  All of these optree
 C<expr> supplies the list of values to iterate over.  C<block> supplies
 the main body of the loop, and C<cont> optionally supplies a C<continue>
 block that operates as a second half of the body.  All of these optree


@@ -7287,13 +7437,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
        }
     }
     else {
        }
     }
     else {

-        const PADOFFSET offset = pad_findmy_pvs("$_", 0);
-       if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
-           sv = newGVOP(OP_GV, 0, PL_defgv);
-       }
-       else {
-           padoff = offset;
-       }
+       sv = newGVOP(OP_GV, 0, PL_defgv);

        iterpflags |= OPpITER_DEF;
     }
 
        iterpflags |= OPpITER_DEF;
     }
 


@@ -7475,9 +7619,10 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block,
     OP *o;
 
     PERL_ARGS_ASSERT_NEWGIVWHENOP;
     OP *o;
 
     PERL_ARGS_ASSERT_NEWGIVWHENOP;

+    PERL_UNUSED_ARG(entertarg); /* used to indicate targ of lexical $_ */

 
     enterop = S_alloc_LOGOP(aTHX_ enter_opcode, block, NULL);
 
     enterop = S_alloc_LOGOP(aTHX_ enter_opcode, block, NULL);

-    enterop->op_targ = ((entertarg == NOT_IN_PAD) ? 0 : entertarg);
+    enterop->op_targ = 0;

     enterop->op_private = 0;
 
     o = newUNOP(leave_opcode, 0, (OP *) enterop);
     enterop->op_private = 0;
 
     o = newUNOP(leave_opcode, 0, (OP *) enterop);


@@ -7596,8 +7741,7 @@ Constructs, checks, and returns an op tree expressing a C<given> block.
 C<cond> supplies the expression that will be locally assigned to a lexical
 variable, and C<block> supplies the body of the C<given> construct; they
 are consumed by this function and become part of the constructed op tree.
 C<cond> supplies the expression that will be locally assigned to a lexical
 variable, and C<block> supplies the body of the C<given> construct; they
 are consumed by this function and become part of the constructed op tree.

-C<defsv_off> is the pad offset of the scalar lexical variable that will
-be affected.  If it is 0, the global C<$_> will be used.
+C<defsv_off> must be zero (it used to identity the pad slot of lexical $_).

 
 =cut
 */
 
 =cut
 */


@@ -7606,11 +7750,14 @@ OP *
 Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off)
 {
     PERL_ARGS_ASSERT_NEWGIVENOP;
 Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off)
 {
     PERL_ARGS_ASSERT_NEWGIVENOP;

+    PERL_UNUSED_ARG(defsv_off);
+
+    assert(!defsv_off);

     return newGIVWHENOP(
        ref_array_or_hash(cond),
        block,
        OP_ENTERGIVEN, OP_LEAVEGIVEN,
     return newGIVWHENOP(
        ref_array_or_hash(cond),
        block,
        OP_ENTERGIVEN, OP_LEAVEGIVEN,

-       defsv_off);
+       0);

 }
 
 /*
 }
 
 /*


@@ -8377,6 +8524,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
                : NULL;
 
     if (block) {
                : NULL;
 
     if (block) {

+       assert(PL_parser);

        /* This makes sub {}; work as expected.  */
        if (block->op_type == OP_STUB) {
            const line_t l = PL_parser->copline;
        /* This makes sub {}; work as expected.  */
        if (block->op_type == OP_STUB) {
            const line_t l = PL_parser->copline;


@@ -8394,7 +8542,8 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
        block->op_next = 0;
         if (ps && !*ps && !attrs && !CvLVALUE(PL_compcv))
             const_sv =
        block->op_next = 0;
         if (ps && !*ps && !attrs && !CvLVALUE(PL_compcv))
             const_sv =

-                S_op_const_sv(aTHX_ start, PL_compcv, CvCLONE(PL_compcv));
+                S_op_const_sv(aTHX_ start, PL_compcv,
+                                        cBOOL(CvCLONE(PL_compcv)));

         else
             const_sv = NULL;
     }
         else
             const_sv = NULL;
     }


@@ -8402,7 +8551,6 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
         const_sv = NULL;
 
     if (SvPOK(gv) || (SvROK(gv) && SvTYPE(SvRV(gv)) != SVt_PVCV)) {
         const_sv = NULL;
 
     if (SvPOK(gv) || (SvROK(gv) && SvTYPE(SvRV(gv)) != SVt_PVCV)) {

-       assert (block);

        cv_ckproto_len_flags((const CV *)gv,
                             o ? (const GV *)cSVOPo->op_sv : NULL, ps,
                             ps_len, ps_utf8|CV_CKPROTO_CURSTASH);
        cv_ckproto_len_flags((const CV *)gv,
                             o ? (const GV *)cSVOPo->op_sv : NULL, ps,
                             ps_len, ps_utf8|CV_CKPROTO_CURSTASH);


@@ -8422,10 +8570,12 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
            if (ckWARN(WARN_REDEFINE)
             || (  ckWARN_d(WARN_REDEFINE)
                && (  !const_sv || SvRV(gv) == const_sv
            if (ckWARN(WARN_REDEFINE)
             || (  ckWARN_d(WARN_REDEFINE)
                && (  !const_sv || SvRV(gv) == const_sv

-                  || sv_cmp(SvRV(gv), const_sv)  )))
+                  || sv_cmp(SvRV(gv), const_sv)  ))) {
+                assert(cSVOPo);

                Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                          "Constant subroutine %"SVf" redefined",
                          SVfARG(cSVOPo->op_sv));
                Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                          "Constant subroutine %"SVf" redefined",
                          SVfARG(cSVOPo->op_sv));

+            }

 
            SvREFCNT_inc_simple_void_NN(PL_compcv);
            CopLINE_set(PL_curcop, oldline);
 
            SvREFCNT_inc_simple_void_NN(PL_compcv);
            CopLINE_set(PL_curcop, oldline);


@@ -8800,7 +8950,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
 /*
 =for apidoc newCONSTSUB_flags
 
 /*
 =for apidoc newCONSTSUB_flags
 

-Creates a constant sub equivalent to Perl C<sub FOO () { 123 }> which is
+Creates a constant sub equivalent to Perl S<C<sub FOO () { 123 }>> which is

 eligible for inlining at compile-time.
 
 Currently, the only useful value for C<flags> is C<SVf_UTF8>.
 eligible for inlining at compile-time.
 
 Currently, the only useful value for C<flags> is C<SVf_UTF8>.


@@ -8808,7 +8958,7 @@ Currently, the only useful value for C<flags> is C<SVf_UTF8>.
 The newly created subroutine takes ownership of a reference to the passed in
 SV.
 
 The newly created subroutine takes ownership of a reference to the passed in
 SV.
 

-Passing C<NULL> for SV creates a constant sub equivalent to C<sub BAR () {}>,
+Passing C<NULL> for SV creates a constant sub equivalent to S<C<sub BAR () {}>>,

 which won't be called if used as a destructor, but will suppress the overhead
 of a call to C<AUTOLOAD>.  (This form, however, isn't eligible for inlining at
 compile time.)
 which won't be called if used as a destructor, but will suppress the overhead
 of a call to C<AUTOLOAD>.  (This form, however, isn't eligible for inlining at
 compile time.)


@@ -9003,7 +9153,7 @@ Perl_newSTUB(pTHX_ GV *gv, bool fake)
     assert(!GvCVu(gv));
     GvCV_set(gv, cv);
     GvCVGEN(gv) = 0;
     assert(!GvCVu(gv));
     GvCV_set(gv, cv);
     GvCVGEN(gv) = 0;

-    if (!fake && HvENAME_HEK(GvSTASH(gv)))
+    if (!fake && GvSTASH(gv) && HvENAME_HEK(GvSTASH(gv)))

        gv_method_changed(gv);
     if (SvFAKE(gv)) {
        cvgv = gv_fetchsv((SV *)gv, GV_ADDMULTI, SVt_PVCV);
        gv_method_changed(gv);
     if (SvFAKE(gv)) {
        cvgv = gv_fetchsv((SV *)gv, GV_ADDMULTI, SVt_PVCV);


@@ -9710,6 +9860,20 @@ Perl_ck_ftst(pTHX_ OP *o)
            op_free(o);
            return newop;
        }
            op_free(o);
            return newop;
        }

+
+        if ((kidtype == OP_RV2AV || kidtype == OP_PADAV) && ckWARN(WARN_SYNTAX)) {
+            SV *name = S_op_varname_subscript(aTHX_ (OP*)kid, 2);
+            if (name) {
+                /* diag_listed_as: Array passed to stat will be coerced to a scalar%s */
+                Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%s (did you want stat %" SVf "?)",
+                            array_passed_to_stat, name);
+            }
+            else {
+                /* diag_listed_as: Array passed to stat will be coerced to a scalar%s */
+                Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%s", array_passed_to_stat);
+            }
+       }
+       scalar((OP *) kid);

        if ((PL_hints & HINT_FILETEST_ACCESS) && OP_IS_FILETEST_ACCESS(o->op_type))
            o->op_private |= OPpFT_ACCESS;
        if (type != OP_STAT && type != OP_LSTAT
        if ((PL_hints & HINT_FILETEST_ACCESS) && OP_IS_FILETEST_ACCESS(o->op_type))
            o->op_private |= OPpFT_ACCESS;
        if (type != OP_STAT && type != OP_LSTAT


@@ -10046,7 +10210,6 @@ Perl_ck_grep(pTHX_ OP *o)
     LOGOP *gwop;
     OP *kid;
     const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
     LOGOP *gwop;
     OP *kid;
     const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;

-    PADOFFSET offset;

 
     PERL_ARGS_ASSERT_CK_GREP;
 
 
     PERL_ARGS_ASSERT_CK_GREP;
 


@@ -10073,15 +10236,8 @@ Perl_ck_grep(pTHX_ OP *o)
 
     gwop = S_alloc_LOGOP(aTHX_ type, o, LINKLIST(kid));
     kid->op_next = (OP*)gwop;
 
     gwop = S_alloc_LOGOP(aTHX_ type, o, LINKLIST(kid));
     kid->op_next = (OP*)gwop;

-    offset = pad_findmy_pvs("$_", 0);
-    if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
-       o->op_private = gwop->op_private = 0;
-       gwop->op_targ = pad_alloc(type, SVs_PADTMP);
-    }
-    else {
-       o->op_private = gwop->op_private = OPpGREP_LEX;
-       gwop->op_targ = o->op_targ = offset;
-    }
+    o->op_private = gwop->op_private = 0;
+    gwop->op_targ = pad_alloc(type, SVs_PADTMP);

 
     kid = OpSIBLING(cLISTOPo->op_first);
     for (kid = OpSIBLING(kid); kid; kid = OpSIBLING(kid))
 
     kid = OpSIBLING(cLISTOPo->op_first);
     for (kid = OpSIBLING(kid); kid; kid = OpSIBLING(kid))


@@ -10332,15 +10488,9 @@ Perl_ck_sassign(pTHX_ OP *o)
 OP *
 Perl_ck_match(pTHX_ OP *o)
 {
 OP *
 Perl_ck_match(pTHX_ OP *o)
 {

+    PERL_UNUSED_CONTEXT;

     PERL_ARGS_ASSERT_CK_MATCH;
 
     PERL_ARGS_ASSERT_CK_MATCH;
 

-    if (o->op_type != OP_QR && PL_compcv) {
-       const PADOFFSET offset = pad_findmy_pvs("$_", 0);
-       if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS_isOUR(offset))) {
-           o->op_targ = offset;
-           o->op_private |= OPpTARGET_MY;
-       }
-    }

     if (o->op_type == OP_MATCH || o->op_type == OP_QR)
        o->op_private |= OPpRUNTIME;
     return o;
     if (o->op_type == OP_MATCH || o->op_type == OP_QR)
        o->op_private |= OPpRUNTIME;
     return o;


@@ -10597,6 +10747,12 @@ Perl_ck_require(pTHX_ OP *o)
            s = SvPVX(sv);
            len = SvCUR(sv);
            end = s + len;
            s = SvPVX(sv);
            len = SvCUR(sv);
            end = s + len;

+            /* treat ::foo::bar as foo::bar */
+            if (len >= 2 && s[0] == ':' && s[1] == ':')
+                DIE(aTHX_ "Bareword in require must not start with a double-colon: \"%s\"\n", s);
+            if (s == end)
+                DIE(aTHX_ "Bareword in require maps to empty filename");
+

            for (; s < end; s++) {
                if (*s == ':' && s[1] == ':') {
                    *s = '/';
            for (; s < end; s++) {
                if (*s == ':' && s[1] == ':') {
                    *s = '/';


@@ -11167,11 +11323,20 @@ OP *
 Perl_ck_entersub_args_list(pTHX_ OP *entersubop)
 {
     OP *aop;
 Perl_ck_entersub_args_list(pTHX_ OP *entersubop)
 {
     OP *aop;

+

     PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_LIST;
     PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_LIST;

+

     aop = cUNOPx(entersubop)->op_first;
     if (!OpHAS_SIBLING(aop))
        aop = cUNOPx(aop)->op_first;
     for (aop = OpSIBLING(aop); OpHAS_SIBLING(aop); aop = OpSIBLING(aop)) {
     aop = cUNOPx(entersubop)->op_first;
     if (!OpHAS_SIBLING(aop))
        aop = cUNOPx(aop)->op_first;
     for (aop = OpSIBLING(aop); OpHAS_SIBLING(aop); aop = OpSIBLING(aop)) {

+        /* skip the extra attributes->import() call implicitly added in
+         * something like foo(my $x : bar)
+         */
+        if (   aop->op_type == OP_ENTERSUB
+            && (aop->op_flags & OPf_WANT) == OPf_WANT_VOID
+        )
+            continue;

         list(aop);
         op_lvalue(aop, OP_ENTERSUB);
     }
         list(aop);
         op_lvalue(aop, OP_ENTERSUB);
     }


@@ -11893,13 +12058,14 @@ Perl_ck_each(pTHX_ OP *o)
                 || (  SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVAV
                    && SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVHV  )
                   )
                 || (  SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVAV
                    && SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVHV  )
                   )

-                   /* we let ck_fun handle it */
-                   break;
+                   goto bad;

            default:
            default:

-                Perl_croak_nocontext(
+                qerror(Perl_mess(aTHX_

                     "Experimental %s on scalar is now forbidden",
                     "Experimental %s on scalar is now forbidden",

-                    PL_op_desc[orig_type]);
-                break;
+                     PL_op_desc[orig_type]));
+               bad:
+                bad_type_pv(1, "hash or array", o, kid);
+                return o;

        }
     }
     return ck_fun(o);
        }
     }
     return ck_fun(o);


@@ -12194,7 +12360,7 @@ enum {
                                          that's flagged OA_DANGEROUS */
     AAS_SAFE_SCALAR     = 0x100, /* produces at least one scalar SV that's
                                         not in any of the categories above */
                                          that's flagged OA_DANGEROUS */
     AAS_SAFE_SCALAR     = 0x100, /* produces at least one scalar SV that's
                                         not in any of the categories above */

-    AAS_DEFAV           = 0x200, /* contains just a single '@_' on RHS */
+    AAS_DEFAV           = 0x200  /* contains just a single '@_' on RHS */

 };
 
 
 };
 
 


@@ -12343,7 +12509,8 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, bool top, int *scalars_p)
     default:
         if (PL_opargs[o->op_type] & OA_DANGEROUS) {
             (*scalars_p) += 2;
     default:
         if (PL_opargs[o->op_type] & OA_DANGEROUS) {
             (*scalars_p) += 2;

-            return AAS_DANGEROUS;
+            flags = AAS_DANGEROUS;
+            break;

         }
 
         if (   (PL_opargs[o->op_type] & OA_TARGLEX)
         }
 
         if (   (PL_opargs[o->op_type] & OA_TARGLEX)


@@ -12472,7 +12639,7 @@ S_inplace_aassign(pTHX_ OP *o) {
  * OPpHINT_STRICT_REFS) as found in any rv2av/hv skipped by the caller.
  */
 
  * OPpHINT_STRICT_REFS) as found in any rv2av/hv skipped by the caller.
  */
 

-void
+STATIC void

 S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
 {
     dVAR;
 S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
 {
     dVAR;


@@ -13126,6 +13293,11 @@ Perl_rpeep(pTHX_ OP *o)
        }
 
       redo:
        }
 
       redo:

+
+        /* oldoldop -> oldop -> o should be a chain of 3 adjacent ops */
+        assert(!oldoldop || oldoldop->op_next == oldop);
+        assert(!oldop    || oldop->op_next    == o);
+

        /* By default, this op has now been optimised. A couple of cases below
           clear this again.  */
        o->op_opt = 1;
        /* By default, this op has now been optimised. A couple of cases below
           clear this again.  */
        o->op_opt = 1;


@@ -13447,9 +13619,10 @@ Perl_rpeep(pTHX_ OP *o)
                    op_null(o);
                    if (oldop)
                        oldop->op_next = nextop;
                    op_null(o);
                    if (oldop)
                        oldop->op_next = nextop;

+                    o = nextop;

                    /* Skip (old)oldop assignment since the current oldop's
                       op_next already points to the next op.  */
                    /* Skip (old)oldop assignment since the current oldop's
                       op_next already points to the next op.  */

-                   continue;
+                   goto redo;

                }
            }
            break;
                }
            }
            break;


@@ -13637,7 +13810,7 @@ Perl_rpeep(pTHX_ OP *o)
                     /* Note that you'd normally  expect targs to be
                      * contiguous in my($a,$b,$c), but that's not the case
                      * when external modules start doing things, e.g.
                     /* Note that you'd normally  expect targs to be
                      * contiguous in my($a,$b,$c), but that's not the case
                      * when external modules start doing things, e.g.

-                     i* Function::Parameters */
+                     * Function::Parameters */

                     if (p->op_targ != base + count)
                         break;
                     assert(p->op_targ == base + count);
                     if (p->op_targ != base + count)
                         break;
                     assert(p->op_targ == base + count);


@@ -13661,9 +13834,21 @@ Perl_rpeep(pTHX_ OP *o)
                     break;
 
                 /* there's a biggest base we can fit into a
                     break;
 
                 /* there's a biggest base we can fit into a

-                 * SAVEt_CLEARPADRANGE in pp_padrange */
-                if (intro && base >
-                        (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)))
+                 * SAVEt_CLEARPADRANGE in pp_padrange.
+                 * (The sizeof() stuff will be constant-folded, and is
+                 * intended to avoid getting "comparison is always false"
+                 * compiler warnings. See the comments above
+                 * MEM_WRAP_CHECK for more explanation on why we do this
+                 * in a weird way to avoid compiler warnings.)
+                 */
+                if (   intro
+                    && (8*sizeof(base) >
+                        8*sizeof(UV)-OPpPADRANGE_COUNTSHIFT-SAVE_TIGHT_SHIFT
+                        ? base
+                        : (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT))
+                        ) >
+                        (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT))
+                )

                     break;
 
                 /* Success! We've got another valid pad op to optimise away */
                     break;
 
                 /* Success! We've got another valid pad op to optimise away */


@@ -13681,10 +13866,10 @@ Perl_rpeep(pTHX_ OP *o)
              * optimise away would have exactly the same effect as the
              * padrange.
              * In particular in void context, we can only optimise to
              * optimise away would have exactly the same effect as the
              * padrange.
              * In particular in void context, we can only optimise to

-             * a padrange if see see the complete sequence
+             * a padrange if we see the complete sequence

              *     pushmark, pad*v, ...., list
              *     pushmark, pad*v, ...., list

-             * which has the net effect of of leaving the markstack as it
-             * was.  Not pushing on to the stack (whereas padsv does touch
+             * which has the net effect of leaving the markstack as it
+             * was.  Not pushing onto the stack (whereas padsv does touch

              * the stack) makes no difference in void context.
              */
             assert(followop);
              * the stack) makes no difference in void context.
              */
             assert(followop);


@@ -13846,7 +14031,8 @@ Perl_rpeep(pTHX_ OP *o)
                    oldoldop = NULL;
                    goto redo;
                }
                    oldoldop = NULL;
                    goto redo;
                }

-               o = oldop;
+               o = oldop->op_next;
+                goto redo;

            }
            else if (o->op_next->op_type == OP_RV2SV) {
                if (!(o->op_next->op_private & OPpDEREF)) {
            }
            else if (o->op_next->op_type == OP_RV2SV) {
                if (!(o->op_next->op_private & OPpDEREF)) {


@@ -13895,11 +14081,11 @@ Perl_rpeep(pTHX_ OP *o)
                                  || o->op_next->op_type == OP_NULL))
                o->op_next = o->op_next->op_next;
 
                                  || o->op_next->op_type == OP_NULL))
                o->op_next = o->op_next->op_next;
 

-           /* if we're an OR and our next is a AND in void context, we'll
-              follow it's op_other on short circuit, same for reverse.
+           /* If we're an OR and our next is an AND in void context, we'll
+              follow its op_other on short circuit, same for reverse.

               We can't do this with OP_DOR since if it's true, its return
               value is the underlying value which must be evaluated
               We can't do this with OP_DOR since if it's true, its return
               value is the underlying value which must be evaluated

-              by the next op */
+              by the next op. */

            if (o->op_next &&
                (
                    (IS_AND_OP(o) && IS_OR_OP(o->op_next))
            if (o->op_next &&
                (
                    (IS_AND_OP(o) && IS_OR_OP(o->op_next))


@@ -14143,6 +14329,11 @@ Perl_rpeep(pTHX_ OP *o)
            op_null(o);
            enter->op_private |= OPpITER_REVERSED;
            iter->op_private |= OPpITER_REVERSED;
            op_null(o);
            enter->op_private |= OPpITER_REVERSED;
            iter->op_private |= OPpITER_REVERSED;

+
+            oldoldop = NULL;
+            oldop    = ourlast;
+            o        = oldop->op_next;
+            goto redo;

            
            break;
        }
            
            break;
        }


@@ -14442,10 +14633,12 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
                }
            }
        }
                }
            }
        }

-        /* Some gcc releases emit a warning for this function:
+        /* On some platforms (HP-UX, IA64) gcc emits a warning for this function:

          * op.c: In function 'Perl_custom_op_get_field':
          * op.c:...: warning: 'any.xop_name' may be used uninitialized in this function [-Wmaybe-uninitialized]
          * op.c: In function 'Perl_custom_op_get_field':
          * op.c:...: warning: 'any.xop_name' may be used uninitialized in this function [-Wmaybe-uninitialized]

-         * Whether this is true, is currently unknown. */
+         * This is because on those platforms (with -DEBUGGING) NOT_REACHED
+         * expands to assert(0), which expands to ((0) ? (void)0 :
+         * __assert(...)), and gcc doesn't know that __assert can never return. */

        return any;
     }
 }
        return any;
     }
 }


@@ -14519,13 +14712,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code,
     case KEY_keys:    retsetpvs("\\[%@]", OP_KEYS);
     case KEY_values:  retsetpvs("\\[%@]", OP_VALUES);
     case KEY_each:    retsetpvs("\\[%@]", OP_EACH);
     case KEY_keys:    retsetpvs("\\[%@]", OP_KEYS);
     case KEY_values:  retsetpvs("\\[%@]", OP_VALUES);
     case KEY_each:    retsetpvs("\\[%@]", OP_EACH);

-    case KEY_push:    retsetpvs("\\@@", OP_PUSH);
-    case KEY_unshift: retsetpvs("\\@@", OP_UNSHIFT);
-    case KEY_pop:     retsetpvs(";\\@", OP_POP);
-    case KEY_shift:   retsetpvs(";\\@", OP_SHIFT);

     case KEY_pos:     retsetpvs(";\\[$*]", OP_POS);
     case KEY_pos:     retsetpvs(";\\[$*]", OP_POS);

-    case KEY_splice:
-       retsetpvs("\\@;$$@", OP_SPLICE);

     case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__:
        retsetpvs("", 0);
     case KEY_evalbytes:
     case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__:
        retsetpvs("", 0);
     case KEY_evalbytes:


@@ -14605,6 +14792,12 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
                                  newOP(OP_CALLER,0)
                       )
               );
                                  newOP(OP_CALLER,0)
                       )
               );

+    case OP_EACH:
+    case OP_KEYS:
+    case OP_VALUES:
+       o = newUNOP(OP_AVHVSWITCH,0,argop);
+       o->op_private = opnum-OP_EACH;
+       return o;

     case OP_SELECT: /* which represents OP_SSELECT as well */
        if (code)
            return newCONDOP(
     case OP_SELECT: /* which represents OP_SSELECT as well */
        if (code)
            return newCONDOP(