Croak on unimplemented already at import time

[perl5.git] / op.c

diff --git a/op.c b/op.c
index a08be2e..93205fe 100644 (file)
--- a/op.c
+++ b/op.c
@@ -109,6 +109,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 +596,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 +609,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 +714,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 +804,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 +1197,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 +1208,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 +1222,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 +1233,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 +1274,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 +1373,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 +1410,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 +1428,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;


@@ -1539,7 +1550,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 +1563,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 +2312,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 +2352,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 +2389,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 +2609,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 +2630,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)];


@@ -2799,6 +2829,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 +2867,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 */


@@ -2849,9 +2889,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        yyerror(Perl_form(aTHX_ "Can't modify %s in %s",
                     (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
                      ? "do block"
        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;
 


@@ -4032,7 +4070,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 +4178,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 +4272,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;


@@ -4319,8 +4358,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 +4410,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 +4716,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 +4859,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 +4900,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 +4955,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 +5236,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 +5852,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 +5860,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 +6138,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.


@@ -7086,7 +7119,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 +7257,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 +7320,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 +7502,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 +7624,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 +7633,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 +7763,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 +8407,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 +8425,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 +8434,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);


@@ -8800,15 +8831,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.)


@@ -9710,6 +9741,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 +10091,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 +10117,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 +10369,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 +10628,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 +11204,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);
     }


@@ -12194,7 +12240,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 +12389,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 +12519,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 +13173,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 +13499,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 +13690,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 +13714,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 +13746,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 +13911,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 +13961,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 +14209,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;
        }


@@ -14342,7 +14413,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.


@@ -14442,10 +14513,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;
     }
 }


@@ -14479,8 +14552,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