Avoid test noise on non-longdouble.

[perl5.git] / op.c

diff --git a/op.c b/op.c
index ff2848a..e611dbe 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


@@ -860,6 +929,7 @@ Perl_op_clear(pTHX_ OP *o)
         /* FALLTHROUGH */
     case OP_ENTERTRY:
     case OP_ENTEREVAL: /* Was holding hints. */
         /* FALLTHROUGH */
     case OP_ENTERTRY:
     case OP_ENTEREVAL: /* Was holding hints. */

+    case OP_ARGDEFELEM:        /* Was holding signature index. */

        o->op_targ = 0;
        break;
     default:
        o->op_targ = 0;
        break;
     default:


@@ -983,6 +1053,10 @@ Perl_op_clear(pTHX_ OP *o)
 
        break;
 
 
        break;
 

+    case OP_ARGCHECK:
+        PerlMemShared_free(cUNOP_AUXo->op_aux);
+        break;
+

     case OP_MULTIDEREF:
         {
             UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
     case OP_MULTIDEREF:
         {
             UNOP_AUX_item *items = cUNOP_AUXo->op_aux;


@@ -1188,6 +1262,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 +1273,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;


@@ -1211,7 +1287,7 @@ Perl_op_refcnt_unlock(pTHX)
 =for apidoc op_sibling_splice
 
 A general function for editing the structure of an existing chain of
 =for apidoc op_sibling_splice
 
 A general function for editing the structure of an existing chain of

-op_sibling nodes.  By analogy with the perl-level splice() function, allows
+op_sibling nodes.  By analogy with the perl-level C<splice()> function, allows

 you to delete zero or more sequential nodes, replacing them with zero or
 more different nodes.  Performs the necessary op_first/op_last
 housekeeping on the parent node and op_sibling manipulation on the
 you to delete zero or more sequential nodes, replacing them with zero or
 more different nodes.  Performs the necessary op_first/op_last
 housekeeping on the parent node and op_sibling manipulation on the


@@ -1222,22 +1298,22 @@ Note that op_next is not manipulated, and nodes are not freed; that is the
 responsibility of the caller.  It also won't create a new list op for an
 empty list etc; use higher-level functions like op_append_elem() for that.
 
 responsibility of the caller.  It also won't create a new list op for an
 empty list etc; use higher-level functions like op_append_elem() for that.
 

-parent is the parent node of the sibling chain. It may passed as NULL if
+C<parent> is the parent node of the sibling chain. It may passed as C<NULL> if

 the splicing doesn't affect the first or last op in the chain.
 
 the splicing doesn't affect the first or last op in the chain.
 

-start is the node preceding the first node to be spliced.  Node(s)
+C<start> is the node preceding the first node to be spliced.  Node(s)

 following it will be deleted, and ops will be inserted after it.  If it is
 following it will be deleted, and ops will be inserted after it.  If it is

-NULL, the first node onwards is deleted, and nodes are inserted at the
+C<NULL>, the first node onwards is deleted, and nodes are inserted at the

 beginning.
 
 beginning.
 

-del_count is the number of nodes to delete.  If zero, no nodes are deleted.
+C<del_count> is the number of nodes to delete.  If zero, no nodes are deleted.

 If -1 or greater than or equal to the number of remaining kids, all
 remaining kids are deleted.
 
 If -1 or greater than or equal to the number of remaining kids, all
 remaining kids are deleted.
 

-insert is the first of a chain of nodes to be inserted in place of the nodes.
-If NULL, no nodes are inserted.
+C<insert> is the first of a chain of nodes to be inserted in place of the nodes.
+If C<NULL>, no nodes are inserted.

 
 

-The head of the chain of deleted ops is returned, or NULL if no ops were
+The head of the chain of deleted ops is returned, or C<NULL> if no ops were

 deleted.
 
 For example:
 deleted.
 
 For example:


@@ -1263,7 +1339,7 @@ For example:
 
 
 For lower-level direct manipulation of C<op_sibparent> and C<op_moresib>,
 
 
 For lower-level direct manipulation of C<op_sibparent> and C<op_moresib>,

-see C<OpMORESIB_set>, C<OpLASTSIB_set>, C<OpMAYBESIB_set>.
+see C<L</OpMORESIB_set>>, C<L</OpLASTSIB_set>>, C<L</OpMAYBESIB_set>>.

 
 =cut
 */
 
 =cut
 */


@@ -1362,7 +1438,7 @@ Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert)
 /*
 =for apidoc op_parent
 
 /*
 =for apidoc op_parent
 

-Returns the parent OP of o, if it has a parent. Returns NULL otherwise.
+Returns the parent OP of C<o>, if it has a parent. Returns C<NULL> otherwise.

 This function is only available on perls built with C<-DPERL_OP_PARENT>.
 
 =cut
 This function is only available on perls built with C<-DPERL_OP_PARENT>.
 
 =cut


@@ -1399,7 +1475,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;


@@ -1418,7 +1494,7 @@ S_op_sibling_newUNOP(pTHX_ OP *parent, OP *start, I32 type, I32 flags)
  */
 
 LOGOP *
  */
 
 LOGOP *

-S_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
+Perl_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)

 {
     dVAR;
     LOGOP *logop;
 {
     dVAR;
     LOGOP *logop;


@@ -1521,8 +1597,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 +1618,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 +1631,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 +2380,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 +2420,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


@@ -2365,7 +2457,7 @@ S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op)
 
 This function finalizes the optree.  Should be called directly after
 the complete optree is built.  It does some additional
 
 This function finalizes the optree.  Should be called directly after
 the complete optree is built.  It does some additional

-checking which can't be done in the normal ck_xxx functions and makes
+checking which can't be done in the normal C<ck_>xxx functions and makes

 the tree thread-safe.
 
 =cut
 the tree thread-safe.
 
 =cut


@@ -2585,13 +2677,13 @@ S_finalize_op(pTHX_ OP* o)
 
 Propagate lvalue ("modifiable") context to an op and its children.
 C<type> represents the context type, roughly based on the type of op that
 
 Propagate lvalue ("modifiable") context to an op and its children.
 C<type> represents the context type, roughly based on the type of op that

-would do the modifying, although C<local()> is represented by OP_NULL,
+would do the modifying, although C<local()> is represented by C<OP_NULL>,

 because it has no op type of its own (it is signalled by a flag on
 the lvalue op).
 
 This function detects things that can't be modified, such as C<$x+1>, and
 generates errors for them.  For example, C<$x+1 = 2> would cause it to be
 because it has no op type of its own (it is signalled by a flag on
 the lvalue op).
 
 This function detects things that can't be modified, such as C<$x+1>, and
 generates errors for them.  For example, C<$x+1 = 2> would cause it to be

-called with an op of type OP_ADD and a C<type> argument of OP_SASSIGN.
+called with an op of type C<OP_ADD> and a C<type> argument of C<OP_SASSIGN>.

 
 It also flags things that need to behave specially in an lvalue context,
 such as C<$$x = 5> which might have to vivify a reference in C<$x>.
 
 It also flags things that need to behave specially in an lvalue context,
 such as C<$$x = 5> which might have to vivify a reference in C<$x>.


@@ -2606,7 +2698,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 +2809,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 +2847,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 +2895,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 +2903,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 +2941,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 +2957,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 +3050,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 +3112,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 +3124,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 +3196,17 @@ 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:
+           if (!FEATURE_MYREF_IS_ENABLED)
+               Perl_croak(aTHX_ "The experimental declared_refs "
+                                "feature is not enabled");
+           Perl_ck_warner_d(aTHX_
+                    packWARN(WARN_EXPERIMENTAL__DECLARED_REFS),
+                   "Declaring references is experimental");
+           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 +3215,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:


@@ -3119,7 +3259,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        goto nomod;
     }
 
        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 &&
        their argument is a filehandle; thus \stat(".") should not set
        it. AMS 20011102 */
     if (type == OP_REFGEN &&


@@ -3185,6 +3325,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 +3341,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 +3757,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 +3766,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 +3783,17 @@ 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) {
+       if (!FEATURE_MYREF_IS_ENABLED)
+           Perl_croak(aTHX_ "The experimental declared_refs "
+                            "feature is not enabled");
+       Perl_ck_warner_d(aTHX_
+            packWARN(WARN_EXPERIMENTAL__DECLARED_REFS),
+           "Declaring references is experimental");
+       /* 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 +4191,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 +4299,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 +4393,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 +4463,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 +4489,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 +4541,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;
 


@@ -4673,7 +4847,7 @@ consumed by this function and become part of the constructed op tree.
 For most list operators, the check function expects all the kid ops to be
 present already, so calling C<newLISTOP(OP_JOIN, ...)> (e.g.) is not
 appropriate.  What you want to do in that case is create an op of type
 For most list operators, the check function expects all the kid ops to be
 present already, so calling C<newLISTOP(OP_JOIN, ...)> (e.g.) is not
 appropriate.  What you want to do in that case is create an op of type

-OP_LIST, append more children to it, and then call L</op_convert_list>.
+C<OP_LIST>, append more children to it, and then call L</op_convert_list>.

 See L</op_convert_list> for more information.
 
 
 See L</op_convert_list> for more information.
 
 


@@ -4816,8 +4990,8 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
 /*
 =for apidoc newUNOP_AUX
 
 /*
 =for apidoc newUNOP_AUX
 

-Similar to C<newUNOP>, but creates an UNOP_AUX struct instead, with op_aux
-initialised to aux
+Similar to C<newUNOP>, but creates an C<UNOP_AUX> struct instead, with C<op_aux>
+initialised to C<aux>

 
 =cut
 */
 
 =cut
 */


@@ -4857,7 +5031,7 @@ and, shifted up eight bits, the eight bits of C<op_private>, except that
 the bit with value 1 is automatically set.  C<dynamic_meth> supplies an
 op which evaluates method name; it is consumed by this function and
 become part of the constructed op tree.
 the bit with value 1 is automatically set.  C<dynamic_meth> supplies an
 op which evaluates method name; it is consumed by this function and
 become part of the constructed op tree.

-Supported optypes: OP_METHOD.
+Supported optypes: C<OP_METHOD>.

 
 =cut
 */
 
 =cut
 */


@@ -4912,7 +5086,7 @@ method name.  C<type> is the opcode.  C<flags> gives the eight bits of
 C<op_flags>, and, shifted up eight bits, the eight bits of
 C<op_private>.  C<const_meth> supplies a constant method name;
 it must be a shared COW string.
 C<op_flags>, and, shifted up eight bits, the eight bits of
 C<op_private>.  C<const_meth> supplies a constant method name;
 it must be a shared COW string.

-Supported optypes: OP_METHOD_NAMED.
+Supported optypes: C<OP_METHOD_NAMED>.

 
 =cut
 */
 
 =cut
 */


@@ -5193,7 +5367,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;


@@ -5688,7 +5862,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));
        }
 
            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;
        rcop->op_flags |=  ((PL_hints & HINT_RE_EVAL) ? OPf_SPECIAL : 0)
                           | (reglist ? OPf_STACKED : 0);
        rcop->op_targ = cv_targ;


@@ -5752,7 +5926,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor)
            op_prepend_elem(o->op_type, scalar(repl), o);
        }
        else {
            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 */
            rcop->op_private = 1;
 
            /* establish postfix order */


@@ -5809,9 +5983,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 +5991,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


@@ -6105,15 +6269,15 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 Loads the module whose name is pointed to by the string part of name.
 Note that the actual module name, not its filename, should be given.
 Eg, "Foo::Bar" instead of "Foo/Bar.pm".  flags can be any of
 Loads the module whose name is pointed to by the string part of name.
 Note that the actual module name, not its filename, should be given.
 Eg, "Foo::Bar" instead of "Foo/Bar.pm".  flags can be any of

-PERL_LOADMOD_DENY, PERL_LOADMOD_NOIMPORT, or PERL_LOADMOD_IMPORT_OPS
+C<PERL_LOADMOD_DENY>, C<PERL_LOADMOD_NOIMPORT>, or C<PERL_LOADMOD_IMPORT_OPS>

 (or 0 for no flags).  ver, if specified
 and not NULL, provides version semantics
 similar to C<use Foo::Bar VERSION>.  The optional trailing SV*
 (or 0 for no flags).  ver, if specified
 and not NULL, provides version semantics
 similar to C<use Foo::Bar VERSION>.  The optional trailing SV*

-arguments can be used to specify arguments to the module's import()
+arguments can be used to specify arguments to the module's C<import()>

 method, similar to C<use Foo::Bar VERSION LIST>.  They must be
 method, similar to C<use Foo::Bar VERSION LIST>.  They must be

-terminated with a final NULL pointer.  Note that this list can only
-be omitted when the PERL_LOADMOD_NOIMPORT flag has been used.
-Otherwise at least a single NULL pointer to designate the default
+terminated with a final C<NULL> pointer.  Note that this list can only
+be omitted when the C<PERL_LOADMOD_NOIMPORT> flag has been used.
+Otherwise at least a single C<NULL> pointer to designate the default

 import list is required.
 
 The reference count for each specified C<SV*> parameter is decremented.
 import list is required.
 
 The reference count for each specified C<SV*> parameter is decremented.


@@ -6714,24 +6878,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 +6888,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 +6906,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 +6929,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,13 +6976,29 @@ 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 */
 

-    logop = S_alloc_LOGOP(aTHX_ type, first, LINKLIST(other));
+    /* 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 = alloc_LOGOP(type, first, LINKLIST(other));

     logop->op_flags |= (U8)flags;
     logop->op_private = (U8)(1 | (flags >> 8));
 
     logop->op_flags |= (U8)flags;
     logop->op_private = (U8)(1 | (flags >> 8));
 


@@ -6902,7 +7069,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
        live->op_folded = 1;
        return live;
     }
        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);
     logop->op_flags |= (U8)flags;
     logop->op_private = (U8)(1 | (flags >> 8));
     logop->op_next = LINKLIST(falseop);


@@ -6951,7 +7118,7 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
 
     PERL_ARGS_ASSERT_NEWRANGE;
 
 
     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));
     range->op_flags = OPf_KIDS;
     leftstart = LINKLIST(left);
     range->op_private = (U8)(1 | (flags >> 8));


@@ -7086,7 +7253,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 +7391,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 +7454,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 +7636,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->op_targ = ((entertarg == NOT_IN_PAD) ? 0 : entertarg);
+    enterop = alloc_LOGOP(enter_opcode, block, NULL);
+    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 +7758,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 $_ will be used.
+C<defsv_off> must be zero (it used to identity the pad slot of lexical $_).

 
 =cut
 */
 
 =cut
 */


@@ -7606,11 +7767,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);

 }
 
 /*
 }
 
 /*


@@ -7733,7 +7897,7 @@ static void const_av_xsub(pTHX_ CV* cv);
 =for apidoc cv_const_sv
 
 If C<cv> is a constant sub eligible for inlining, returns the constant
 =for apidoc cv_const_sv
 
 If C<cv> is a constant sub eligible for inlining, returns the constant

-value returned by the sub.  Otherwise, returns NULL.
+value returned by the sub.  Otherwise, returns C<NULL>.

 
 Constant subs can be created with C<newCONSTSUB> or as described in
 L<perlsub/"Constant Functions">.
 
 Constant subs can be created with C<newCONSTSUB> or as described in
 L<perlsub/"Constant Functions">.


@@ -8377,6 +8541,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 +8559,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 +8568,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 +8587,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,15 +8967,15 @@ 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.
 
 eligible for inlining at compile-time.
 

-Currently, the only useful value for C<flags> is SVf_UTF8.
+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 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 +9170,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);


@@ -9512,7 +9679,7 @@ Perl_ck_eval(pTHX_ OP *o)
             op_sibling_splice(o, NULL, -1, NULL);
            op_free(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;
 
            /* establish postfix order */
            enter->op_next = (OP*)enter;


@@ -9710,6 +9877,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 +10227,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;
 


@@ -10071,17 +10251,10 @@ Perl_ck_grep(pTHX_ OP *o)
        Perl_croak(aTHX_ "panic: ck_grep, type=%u", (unsigned) kid->op_type);
     kid = kUNOP->op_first;
 
        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;
     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 +10505,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 +10764,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 +11340,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 +12075,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 +12377,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 */

 };
 
 
 };
 
 


@@ -12314,6 +12497,15 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, bool top, int *scalars_p)
         break;
 
     case OP_UNDEF:
         break;
 
     case OP_UNDEF:

+        /* undef counts as a scalar on the RHS:
+         *   (undef, $x) = ...;         # only 1 scalar on LHS: always safe
+         *   ($x, $y)    = (undef, $x); # 2 scalars on RHS: unsafe
+         */
+        if (rhs)
+            (*scalars_p)++;
+        flags = AAS_SAFE_SCALAR;
+        break;
+

     case OP_PUSHMARK:
     case OP_STUB:
         /* these are all no-ops; they don't push a potentially common SV
     case OP_PUSHMARK:
     case OP_STUB:
         /* these are all no-ops; they don't push a potentially common SV


@@ -12334,7 +12526,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)


@@ -12463,7 +12656,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;


@@ -12851,6 +13044,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;
                 is_last = TRUE;
                 index_skip = action_count;
                 action |= MDEREF_FLAG_last;

+                if (index_type != MDEREF_INDEX_none)
+                    arg--;

             }
 
             if (pass)
             }
 
             if (pass)


@@ -13117,6 +13312,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;


@@ -13438,9 +13638,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;


@@ -13474,7 +13675,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,
            /* 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 */
            /* op_seq functionality is now replaced by op_opt */
            o->op_opt = 0;
            /* FALLTHROUGH */


@@ -13628,7 +13829,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);


@@ -13652,9 +13853,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 */


@@ -13672,10 +13885,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);


@@ -13837,7 +14050,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)) {


@@ -13886,11 +14100,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))


@@ -13955,6 +14169,7 @@ Perl_rpeep(pTHX_ OP *o)
        case OP_DORASSIGN:
        case OP_RANGE:
        case OP_ONCE:
        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);
            while (cLOGOP->op_other->op_type == OP_NULL)
                cLOGOP->op_other = cLOGOP->op_other->op_next;
            DEFER(cLOGOP->op_other);


@@ -14134,6 +14349,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;
        }


@@ -14247,7 +14467,7 @@ Perl_rpeep(pTHX_ OP *o)
                 || !r                      /* .... = (); */
                 || !(l & ~AAS_SAFE_SCALAR) /* (undef, pos()) = ...; */
                 || !(r & ~AAS_SAFE_SCALAR) /* ... = (1,2,length,undef); */
                 || !r                      /* .... = (); */
                 || !(l & ~AAS_SAFE_SCALAR) /* (undef, pos()) = ...; */
                 || !(r & ~AAS_SAFE_SCALAR) /* ... = (1,2,length,undef); */

-                || (lscalars < 2)          /* ($x) = ... */
+                || (lscalars < 2)          /* ($x, undef) = ... */

             ) {
                 NOOP; /* always safe */
             }
             ) {
                 NOOP; /* always safe */
             }


@@ -14291,7 +14511,7 @@ Perl_rpeep(pTHX_ OP *o)
 
             /* ... = ($x)
              * may have to handle aggregate on LHS, but we can't
 
             /* ... = ($x)
              * may have to handle aggregate on LHS, but we can't

-             * have common scalars*/
+             * have common scalars. */

             if (rscalars < 2)
                 o->op_private &=
                         ~(OPpASSIGN_COMMON_SCALAR|OPpASSIGN_COMMON_RC1);
             if (rscalars < 2)
                 o->op_private &=
                         ~(OPpASSIGN_COMMON_SCALAR|OPpASSIGN_COMMON_RC1);


@@ -14333,7 +14553,7 @@ Perl_peep(pTHX_ OP *o)
 
 =for apidoc Ao||custom_op_xop
 Return the XOP structure for a given custom op.  This macro should be
 
 =for apidoc Ao||custom_op_xop
 Return the XOP structure for a given custom op.  This macro should be

-considered internal to OP_NAME and the other access macros: use them instead.
+considered internal to C<OP_NAME> and the other access macros: use them instead.

 This macro does call a function.  Prior
 to 5.19.6, this was implemented as a
 function.
 This macro does call a function.  Prior
 to 5.19.6, this was implemented as a
 function.


@@ -14433,10 +14653,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;
     }
 }


@@ -14470,8 +14692,8 @@ Perl_custom_op_register(pTHX_ Perl_ppaddr_t ppaddr, const XOP *xop)
 =for apidoc core_prototype
 
 This function assigns the prototype of the named core function to C<sv>, or
 =for apidoc core_prototype
 
 This function assigns the prototype of the named core function to C<sv>, or

-to a new mortal SV if C<sv> is NULL.  It returns the modified C<sv>, or
-NULL if the core function has no prototype.  C<code> is a code as returned
+to a new mortal SV if C<sv> is C<NULL>.  It returns the modified C<sv>, or
+C<NULL> if the core function has no prototype.  C<code> is a code as returned

 by C<keyword()>.  It must not be equal to 0.
 
 =cut
 by C<keyword()>.  It must not be equal to 0.
 
 =cut


@@ -14510,13 +14732,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:


@@ -14596,6 +14812,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(


@@ -14804,6 +15026,7 @@ const_av_xsub(pTHX_ CV* cv)
     XSRETURN(AvFILLp(av)+1);
 }
 
     XSRETURN(AvFILLp(av)+1);
 }
 

+

 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */