evalbytes should ignore outer utf8 declaration

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 939b478..93a9678 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1114,6 +1114,7 @@ Perl_scalarvoid(pTHX_ OP *o)
     case OP_GGRGID:
     case OP_GETLOGIN:
     case OP_PROTOTYPE:
     case OP_GGRGID:
     case OP_GETLOGIN:
     case OP_PROTOTYPE:

+    case OP_RUNCV:

       func_ops:
        if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
            /* Otherwise it's "Useless use of grep iterator" */
       func_ops:
        if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
            /* Otherwise it's "Useless use of grep iterator" */


@@ -1467,7 +1468,7 @@ Perl_finalize_optree(pTHX_ OP* o)
     LEAVE;
 }
 
     LEAVE;
 }
 

-void
+STATIC void

 S_finalize_op(pTHX_ OP* o)
 {
     PERL_ARGS_ASSERT_FINALIZE_OP;
 S_finalize_op(pTHX_ OP* o)
 {
     PERL_ARGS_ASSERT_FINALIZE_OP;


@@ -2558,11 +2559,26 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
                       || rtype == OP_TRANSR
                       )
                       ? (int)rtype : OP_MATCH];
                       || rtype == OP_TRANSR
                       )
                       ? (int)rtype : OP_MATCH];

-      const char * const sample = ((ltype == OP_RV2AV || ltype == OP_PADAV)
+      const bool isary = ltype == OP_RV2AV || ltype == OP_PADAV;
+      GV *gv;
+      SV * const name =
+       (ltype == OP_RV2AV || ltype == OP_RV2HV)
+        ?    cUNOPx(left)->op_first->op_type == OP_GV
+          && (gv = cGVOPx_gv(cUNOPx(left)->op_first))
+              ? varname(gv, isary ? '@' : '%', 0, NULL, 0, 1)
+              : NULL
+        : varname(NULL, isary ? '@' : '%', left->op_targ, NULL, 0, 1);
+      if (name)
+       Perl_warner(aTHX_ packWARN(WARN_MISC),
+             "Applying %s to %"SVf" will act on scalar(%"SVf")",
+             desc, name, name);
+      else {
+       const char * const sample = (isary

             ? "@array" : "%hash");
             ? "@array" : "%hash");

-      Perl_warner(aTHX_ packWARN(WARN_MISC),
+       Perl_warner(aTHX_ packWARN(WARN_MISC),

              "Applying %s to %s will act on scalar(%s)",
              desc, sample, sample);
              "Applying %s to %s will act on scalar(%s)",
              desc, sample, sample);

+      }

     }
 
     if (rtype == OP_CONST &&
     }
 
     if (rtype == OP_CONST &&


@@ -3091,6 +3107,7 @@ OP *
 Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
 {
     dVAR;
 Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
 {
     dVAR;

+    if (type < 0) type = -type, flags |= OPf_SPECIAL;

     if (!o || o->op_type != OP_LIST)
        o = newLISTOP(OP_LIST, 0, o, NULL);
     else
     if (!o || o->op_type != OP_LIST)
        o = newLISTOP(OP_LIST, 0, o, NULL);
     else


@@ -3597,6 +3614,11 @@ Perl_newOP(pTHX_ I32 type, I32 flags)
     dVAR;
     OP *o;
 
     dVAR;
     OP *o;
 

+    if (type == -OP_ENTEREVAL) {
+       type = OP_ENTEREVAL;
+       flags |= OPpEVAL_BYTES<<8;
+    }
+

     assert((PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP
        || (PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP_OR_UNOP
        || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP
     assert((PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP
        || (PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP_OR_UNOP
        || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP


@@ -3639,6 +3661,11 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
     dVAR;
     UNOP *unop;
 
     dVAR;
     UNOP *unop;
 

+    if (type == -OP_ENTEREVAL) {
+       type = OP_ENTEREVAL;
+       flags |= OPpEVAL_BYTES<<8;
+    }
+

     assert((PL_opargs[type] & OA_CLASS_MASK) == OA_UNOP
        || (PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP_OR_UNOP
        || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP
     assert((PL_opargs[type] & OA_CLASS_MASK) == OA_UNOP
        || (PL_opargs[type] & OA_CLASS_MASK) == OA_BASEOP_OR_UNOP
        || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP


@@ -4508,10 +4535,10 @@ Perl_package(pTHX_ OP *o)
 
     PERL_ARGS_ASSERT_PACKAGE;
 
 
     PERL_ARGS_ASSERT_PACKAGE;
 

-    save_hptr(&PL_curstash);
+    SAVEGENERICSV(PL_curstash);

     save_item(PL_curstname);
 
     save_item(PL_curstname);
 

-    PL_curstash = gv_stashsv(sv, GV_ADD);
+    PL_curstash = (HV *)SvREFCNT_inc(gv_stashsv(sv, GV_ADD));

 
     sv_setsv(PL_curstname, sv);
 
 
     sv_setsv(PL_curstname, sv);
 


@@ -6250,9 +6277,23 @@ void
 Perl_cv_ckproto_len_flags(pTHX_ const CV *cv, const GV *gv, const char *p,
                    const STRLEN len, const U32 flags)
 {
 Perl_cv_ckproto_len_flags(pTHX_ const CV *cv, const GV *gv, const char *p,
                    const STRLEN len, const U32 flags)
 {

+    const char * const cvp = CvPROTO(cv);
+    const STRLEN clen = CvPROTOLEN(cv);
+

     PERL_ARGS_ASSERT_CV_CKPROTO_LEN_FLAGS;
     PERL_ARGS_ASSERT_CV_CKPROTO_LEN_FLAGS;

-    if (((!p != !SvPOK(cv)) /* One has prototype, one has not.  */
-        || (p && !sv_eq((SV*)cv, newSVpvn_flags(p, len, flags | SVs_TEMP))))
+
+    if (((!p != !cvp) /* One has prototype, one has not.  */
+       || (p && (
+                 (flags & SVf_UTF8) == SvUTF8(cv)
+                  ? len != clen || memNE(cvp, p, len)
+                  : flags & SVf_UTF8
+                     ? bytes_cmp_utf8((const U8 *)cvp, clen,
+                                      (const U8 *)p, len)
+                     : bytes_cmp_utf8((const U8 *)p, len,
+                                      (const U8 *)cvp, clen)
+                )
+          )
+        )

         && ckWARN_d(WARN_PROTOTYPE)) {
        SV* const msg = sv_newmortal();
        SV* name = NULL;
         && ckWARN_d(WARN_PROTOTYPE)) {
        SV* const msg = sv_newmortal();
        SV* name = NULL;


@@ -6263,7 +6304,9 @@ Perl_cv_ckproto_len_flags(pTHX_ const CV *cv, const GV *gv, const char *p,
        if (name)
            Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, SVfARG(name));
        if (SvPOK(cv))
        if (name)
            Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, SVfARG(name));
        if (SvPOK(cv))

-           Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", SVfARG(cv));
+           Perl_sv_catpvf(aTHX_ msg, " (%"SVf")",
+               SVfARG(newSVpvn_flags(cvp,clen, SvUTF8(cv)|SVs_TEMP))
+           );

        else
            sv_catpvs(msg, ": none");
        sv_catpvs(msg, " vs ");
        else
            sv_catpvs(msg, ": none");
        sv_catpvs(msg, " vs ");


@@ -6431,7 +6474,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        = (block || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS)
           || PL_madskills)
        ? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT;
        = (block || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS)
           || PL_madskills)
        ? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT;

-    const char * const name = o ? SvPV_nolen_const(cSVOPo->op_sv) : NULL;
+    STRLEN namlen = 0;
+    const char * const name = o ? SvPV_const(cSVOPo->op_sv, namlen) : NULL;

     bool has_name;
     bool name_is_utf8 = o ? (SvUTF8(cSVOPo->op_sv) ? 1 : 0) : 0;
 
     bool has_name;
     bool name_is_utf8 = o ? (SvUTF8(cSVOPo->op_sv) ? 1 : 0) : 0;
 


@@ -6540,19 +6584,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                && block->op_type != OP_NULL
 #endif
                ) {
                && block->op_type != OP_NULL
 #endif
                ) {

-               if (ckWARN(WARN_REDEFINE)
-                   || (CvCONST(cv)
-                       && (!const_sv || sv_cmp(cv_const_sv(cv), const_sv))))
-               {
-                   const line_t oldline = CopLINE(PL_curcop);
-                   if (PL_parser && PL_parser->copline != NOLINE)
+               const line_t oldline = CopLINE(PL_curcop);
+               if (PL_parser && PL_parser->copline != NOLINE)

                        CopLINE_set(PL_curcop, PL_parser->copline);
                        CopLINE_set(PL_curcop, PL_parser->copline);

-                   Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                       CvCONST(cv) ? "Constant subroutine %"SVf" redefined"
-                                   : "Subroutine %"SVf" redefined",
-                                    SVfARG(cSVOPo->op_sv));
-                   CopLINE_set(PL_curcop, oldline);
-               }
+               report_redefined_cv(cSVOPo->op_sv, cv, &const_sv);
+               CopLINE_set(PL_curcop, oldline);

 #ifdef PERL_MAD
                if (!PL_minus_c)        /* keep old one around for madskills */
 #endif
 #ifdef PERL_MAD
                if (!PL_minus_c)        /* keep old one around for madskills */
 #endif


@@ -6565,6 +6601,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
     }
     if (const_sv) {
        }
     }
     if (const_sv) {

+       HV *stash;

        SvREFCNT_inc_simple_void_NN(const_sv);
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
        SvREFCNT_inc_simple_void_NN(const_sv);
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));


@@ -6576,15 +6613,19 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
        else {
            GvCV_set(gv, NULL);
        }
        else {
            GvCV_set(gv, NULL);

-           cv = newCONSTSUB_flags(NULL, name, name_is_utf8 ? SVf_UTF8 : 0, const_sv);
+           cv = newCONSTSUB_flags(
+               NULL, name, namlen, name_is_utf8 ? SVf_UTF8 : 0,
+               const_sv
+           );

        }
        }

-        mro_method_changed_in( /* sub Foo::Bar () { 123 } */
+       stash =

             (CvGV(cv) && GvSTASH(CvGV(cv)))
                 ? GvSTASH(CvGV(cv))
                 : CvSTASH(cv)
                     ? CvSTASH(cv)
             (CvGV(cv) && GvSTASH(CvGV(cv)))
                 ? GvSTASH(CvGV(cv))
                 : CvSTASH(cv)
                     ? CvSTASH(cv)

-                    : PL_curstash
-        );
+                    : PL_curstash;
+       if (HvENAME_HEK(stash))
+            mro_method_changed_in(stash); /* sub Foo::Bar () { 123 } */

        if (PL_madskills)
            goto install_block;
        op_free(block);
        if (PL_madskills)
            goto install_block;
        op_free(block);


@@ -6646,7 +6687,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                }
            }
            GvCVGEN(gv) = 0;
                }
            }
            GvCVGEN(gv) = 0;

-            mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar { (shift)+1 } */
+           if (HvENAME_HEK(GvSTASH(gv)))
+               /* sub Foo::bar { (shift)+1 } */
+               mro_method_changed_in(GvSTASH(gv));

        }
     }
     if (!CvGV(cv)) {
        }
     }
     if (!CvGV(cv)) {


@@ -6654,12 +6697,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        CvFILE_set_from_cop(cv, PL_curcop);
        CvSTASH_set(cv, PL_curstash);
     }
        CvFILE_set_from_cop(cv, PL_curcop);
        CvSTASH_set(cv, PL_curstash);
     }

-  attrs:
-    if (attrs) {
-       /* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */
-       HV *stash = name && GvSTASH(CvGV(cv)) ? GvSTASH(CvGV(cv)) : PL_curstash;
-       apply_attrs(stash, MUTABLE_SV(cv), attrs, FALSE);
-    }

 
     if (ps) {
        sv_setpvn(MUTABLE_SV(cv), ps, ps_len);
 
     if (ps) {
        sv_setpvn(MUTABLE_SV(cv), ps, ps_len);


@@ -6687,7 +6724,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     }
  install_block:
     if (!block)
     }
  install_block:
     if (!block)

-       goto done;
+       goto attrs;

 
     /* If we assign an optree to a PVCV, then we've defined a subroutine that
        the debugger could be able to set a breakpoint in, so signal to
 
     /* If we assign an optree to a PVCV, then we've defined a subroutine that
        the debugger could be able to set a breakpoint in, so signal to


@@ -6727,7 +6764,14 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            CvCONST_on(cv);
     }
 
            CvCONST_on(cv);
     }
 

-    if (has_name) {
+  attrs:
+    if (attrs) {
+       /* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */
+       HV *stash = name && GvSTASH(CvGV(cv)) ? GvSTASH(CvGV(cv)) : PL_curstash;
+       apply_attrs(stash, MUTABLE_SV(cv), attrs, FALSE);
+    }
+
+    if (block && has_name) {

        if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
            SV * const tmpstr = sv_newmortal();
            GV * const db_postponed = gv_fetchpvs("DB::postponed",
        if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
            SV * const tmpstr = sv_newmortal();
            GV * const db_postponed = gv_fetchpvs("DB::postponed",


@@ -6779,13 +6823,13 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
            ENTER;
            SAVECOPFILE(&PL_compiling);
            SAVECOPLINE(&PL_compiling);
            ENTER;
            SAVECOPFILE(&PL_compiling);
            SAVECOPLINE(&PL_compiling);

+           SAVEVPTR(PL_curcop);

 
            DEBUG_x( dump_sub(gv) );
            Perl_av_create_and_push(aTHX_ &PL_beginav, MUTABLE_SV(cv));
            GvCV_set(gv,0);             /* cv has been hijacked */
            call_list(oldscope, PL_beginav);
 
 
            DEBUG_x( dump_sub(gv) );
            Perl_av_create_and_push(aTHX_ &PL_beginav, MUTABLE_SV(cv));
            GvCV_set(gv,0);             /* cv has been hijacked */
            call_list(oldscope, PL_beginav);
 

-           PL_curcop = &PL_compiling;

            CopHINTS_set(&PL_compiling, PL_hints);
            LEAVE;
        }
            CopHINTS_set(&PL_compiling, PL_hints);
            LEAVE;
        }


@@ -6841,7 +6885,7 @@ See L</newCONSTSUB_flags>.
 CV *
 Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
 {
 CV *
 Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
 {

-    return newCONSTSUB_flags(stash, name, 0, sv);
+    return newCONSTSUB_flags(stash, name, name ? strlen(name) : 0, 0, sv);

 }
 
 /*
 }
 
 /*


@@ -6861,7 +6905,8 @@ compile time.)
 */
 
 CV *
 */
 
 CV *

-Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, U32 flags, SV *sv)
+Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, STRLEN len,
+                             U32 flags, SV *sv)

 {
     dVAR;
     CV* cv;
 {
     dVAR;
     CV* cv;


@@ -6879,6 +6924,8 @@ Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, U32 flags, SV *sv)
         * an op shared between threads. Use a non-shared COP for our
         * dirty work */
         SAVEVPTR(PL_curcop);
         * an op shared between threads. Use a non-shared COP for our
         * dirty work */
         SAVEVPTR(PL_curcop);

+        SAVECOMPILEWARNINGS();
+        PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);

         PL_curcop = &PL_compiling;
     }
     SAVECOPLINE(PL_curcop);
         PL_curcop = &PL_compiling;
     }
     SAVECOPLINE(PL_curcop);


@@ -6888,9 +6935,9 @@ Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, U32 flags, SV *sv)
     PL_hints &= ~HINT_BLOCK_SCOPE;
 
     if (stash) {
     PL_hints &= ~HINT_BLOCK_SCOPE;
 
     if (stash) {

-       SAVESPTR(PL_curstash);
+       SAVEGENERICSV(PL_curstash);

        SAVECOPSTASH(PL_curcop);
        SAVECOPSTASH(PL_curcop);

-       PL_curstash = stash;
+       PL_curstash = (HV *)SvREFCNT_inc_simple_NN(stash);

        CopSTASH_set(PL_curcop,stash);
     }
 
        CopSTASH_set(PL_curcop,stash);
     }
 


@@ -6898,8 +6945,8 @@ Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, U32 flags, SV *sv)
        and so doesn't get free()d.  (It's expected to be from the C pre-
        processor __FILE__ directive). But we need a dynamically allocated one,
        and we need it to get freed.  */
        and so doesn't get free()d.  (It's expected to be from the C pre-
        processor __FILE__ directive). But we need a dynamically allocated one,
        and we need it to get freed.  */

-    cv = newXS_flags(name, const_sv_xsub, file ? file : "", "",
-                    XS_DYNAMIC_FILENAME | flags);
+    cv = newXS_len_flags(name, len, const_sv_xsub, file ? file : "", "",
+                        &sv, XS_DYNAMIC_FILENAME | flags);

     CvXSUBANY(cv).any_ptr = sv;
     CvCONST_on(cv);
 
     CvXSUBANY(cv).any_ptr = sv;
     CvCONST_on(cv);
 


@@ -6917,12 +6964,28 @@ Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr,
                 const char *const filename, const char *const proto,
                 U32 flags)
 {
                 const char *const filename, const char *const proto,
                 U32 flags)
 {

+    PERL_ARGS_ASSERT_NEWXS_FLAGS;
+    return newXS_len_flags(
+       name, name ? strlen(name) : 0, subaddr, filename, proto, NULL, flags
+    );
+}
+
+CV *
+Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
+                          XSUBADDR_t subaddr, const char *const filename,
+                          const char *const proto, SV **const_svp,
+                          U32 flags)
+{

     CV *cv;
 
     CV *cv;
 

-    PERL_ARGS_ASSERT_NEWXS_FLAGS;
+    PERL_ARGS_ASSERT_NEWXS_LEN_FLAGS;

 
     {
 
     {

-        GV * const gv = gv_fetchpv(name ? name :
+        GV * const gv = name
+                        ? gv_fetchpvn(
+                               name,len,GV_ADDMULTI|flags,SVt_PVCV
+                          )
+                        : gv_fetchpv(

                             (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
                             GV_ADDMULTI | flags, SVt_PVCV);
     
                             (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
                             GV_ADDMULTI | flags, SVt_PVCV);
     


@@ -6937,25 +7000,17 @@ Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr,
             }
             else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
                 /* already defined (or promised) */
             }
             else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
                 /* already defined (or promised) */

-                if (ckWARN(WARN_REDEFINE)) {
-                    GV * const gvcv = CvGV(cv);
-                    if (gvcv) {
-                        HV * const stash = GvSTASH(gvcv);
-                        if (stash) {
-                            const char *redefined_name = HvNAME_get(stash);
-                            if ( redefined_name &&
-                                 strEQ(redefined_name,"autouse") ) {
-                                const line_t oldline = CopLINE(PL_curcop);
-                                if (PL_parser && PL_parser->copline != NOLINE)
-                                    CopLINE_set(PL_curcop, PL_parser->copline);
-                                Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
-                                            CvCONST(cv) ? "Constant subroutine %s redefined"
-                                                        : "Subroutine %s redefined"
-                                            ,name);
-                                CopLINE_set(PL_curcop, oldline);
-                            }
-                        }
-                    }
+                /* Redundant check that allows us to avoid creating an SV
+                   most of the time: */
+                if (CvCONST(cv) || ckWARN(WARN_REDEFINE)) {
+                    const line_t oldline = CopLINE(PL_curcop);
+                    if (PL_parser && PL_parser->copline != NOLINE)
+                        CopLINE_set(PL_curcop, PL_parser->copline);
+                    report_redefined_cv(newSVpvn_flags(
+                                         name,len,(flags&SVf_UTF8)|SVs_TEMP
+                                        ),
+                                        cv, const_svp);
+                    CopLINE_set(PL_curcop, oldline);

                 }
                 SvREFCNT_dec(cv);
                 cv = NULL;
                 }
                 SvREFCNT_dec(cv);
                 cv = NULL;


@@ -6969,7 +7024,8 @@ Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr,
             if (name) {
                 GvCV_set(gv,cv);
                 GvCVGEN(gv) = 0;
             if (name) {
                 GvCV_set(gv,cv);
                 GvCVGEN(gv) = 0;

-                mro_method_changed_in(GvSTASH(gv)); /* newXS */
+                if (HvENAME_HEK(GvSTASH(gv)))
+                    mro_method_changed_in(GvSTASH(gv)); /* newXS */

             }
         }
         if (!name)
             }
         }
         if (!name)


@@ -7261,6 +7317,32 @@ Perl_ck_bitop(pTHX_ OP *o)
     return o;
 }
 
     return o;
 }
 

+PERL_STATIC_INLINE bool
+is_dollar_bracket(pTHX_ const OP * const o)
+{
+    const OP *kid;
+    return o->op_type == OP_RV2SV && o->op_flags & OPf_KIDS
+       && (kid = cUNOPx(o)->op_first)
+       && kid->op_type == OP_GV
+       && strEQ(GvNAME(cGVOPx_gv(kid)), "[");
+}
+
+OP *
+Perl_ck_cmp(pTHX_ OP *o)
+{
+    PERL_ARGS_ASSERT_CK_CMP;
+    if (ckWARN(WARN_SYNTAX)) {
+       const OP *kid = cUNOPo->op_first;
+       if (kid && (
+               is_dollar_bracket(aTHX_ kid)
+            || ((kid = kid->op_sibling) && is_dollar_bracket(aTHX_ kid))
+          ))
+           Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+                       "$[ used in %s (did you mean $] ?)", OP_DESC(o));
+    }
+    return o;
+}
+

 OP *
 Perl_ck_concat(pTHX_ OP *o)
 {
 OP *
 Perl_ck_concat(pTHX_ OP *o)
 {


@@ -7420,21 +7502,28 @@ Perl_ck_eval(pTHX_ OP *o)
        }
     }
     else {
        }
     }
     else {

+       const U8 priv = o->op_private;

 #ifdef PERL_MAD
        OP* const oldo = o;
 #else
        op_free(o);
 #endif
 #ifdef PERL_MAD
        OP* const oldo = o;
 #else
        op_free(o);
 #endif

-       o = newUNOP(OP_ENTEREVAL, 0, newDEFSVOP());
+       o = newUNOP(OP_ENTEREVAL, priv <<8, newDEFSVOP());

        op_getmad(oldo,o,'O');
     }
     o->op_targ = (PADOFFSET)PL_hints;
        op_getmad(oldo,o,'O');
     }
     o->op_targ = (PADOFFSET)PL_hints;

-    if ((PL_hints & HINT_LOCALIZE_HH) != 0 && GvHV(PL_hintgv)) {
+    if (o->op_private & OPpEVAL_BYTES) o->op_targ &= ~HINT_UTF8;
+    if ((PL_hints & HINT_LOCALIZE_HH) != 0
+     && !(o->op_private & OPpEVAL_COPHH) && GvHV(PL_hintgv)) {

        /* Store a copy of %^H that pp_entereval can pick up. */
        OP *hhop = newSVOP(OP_HINTSEVAL, 0,
                           MUTABLE_SV(hv_copy_hints_hv(GvHV(PL_hintgv))));
        cUNOPo->op_first->op_sibling = hhop;
        o->op_private |= OPpEVAL_HAS_HH;
        /* Store a copy of %^H that pp_entereval can pick up. */
        OP *hhop = newSVOP(OP_HINTSEVAL, 0,
                           MUTABLE_SV(hv_copy_hints_hv(GvHV(PL_hintgv))));
        cUNOPo->op_first->op_sibling = hhop;
        o->op_private |= OPpEVAL_HAS_HH;

+
+       if (!(o->op_private & OPpEVAL_BYTES)
+        && FEATURE_IS_ENABLED("unieval"))
+           o->op_private |= OPpEVAL_UNICODE;

     }
     return o;
 }
     }
     return o;
 }


@@ -7966,6 +8055,7 @@ Perl_ck_glob(pTHX_ OP *o)
 {
     dVAR;
     GV *gv;
 {
     dVAR;
     GV *gv;

+    const bool core = o->op_flags & OPf_SPECIAL;

 
     PERL_ARGS_ASSERT_CK_GLOB;
 
 
     PERL_ARGS_ASSERT_CK_GLOB;
 


@@ -7973,7 +8063,8 @@ Perl_ck_glob(pTHX_ OP *o)
     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
        op_append_elem(OP_GLOB, o, newDEFSVOP()); /* glob() => glob($_) */
 
     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
        op_append_elem(OP_GLOB, o, newDEFSVOP()); /* glob() => glob($_) */
 

-    if (!((gv = gv_fetchpvs("glob", GV_NOTQUAL, SVt_PVCV))
+    if (core) gv = NULL;
+    else if (!((gv = gv_fetchpvs("glob", GV_NOTQUAL, SVt_PVCV))

          && GvCVu(gv) && GvIMPORTED_CV(gv)))
     {
        gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV);
          && GvCVu(gv) && GvIMPORTED_CV(gv)))
     {
        gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV);


@@ -7981,21 +8072,13 @@ Perl_ck_glob(pTHX_ OP *o)
 
 #if !defined(PERL_EXTERNAL_GLOB)
     if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
 
 #if !defined(PERL_EXTERNAL_GLOB)
     if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {

-       GV *glob_gv;

        ENTER;
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
                newSVpvs("File::Glob"), NULL, NULL, NULL);
        ENTER;
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
                newSVpvs("File::Glob"), NULL, NULL, NULL);

-       if((glob_gv = gv_fetchpvs("File::Glob::csh_glob", 0, SVt_PVCV))) {
-           gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV);
-           GvCV_set(gv, GvCV(glob_gv));
-           SvREFCNT_inc_void(MUTABLE_SV(GvCV(gv)));
-           GvIMPORTED_CV_on(gv);
-       }

        LEAVE;
     }
        LEAVE;
     }

-#endif /* PERL_EXTERNAL_GLOB */
+#endif /* !PERL_EXTERNAL_GLOB */

 
 

-    assert(!(o->op_flags & OPf_SPECIAL));

     if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {
        /* convert
         *     glob
     if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {
        /* convert
         *     glob


@@ -8022,8 +8105,12 @@ Perl_ck_glob(pTHX_ OP *o)
        o->op_targ = OP_GLOB; /* hint at what it used to be: eg in newWHILEOP */
        return o;
     }
        o->op_targ = OP_GLOB; /* hint at what it used to be: eg in newWHILEOP */
        return o;
     }

+    else o->op_flags &= ~OPf_SPECIAL;

     gv = newGVgen("main");
     gv_IOadd(gv);
     gv = newGVgen("main");
     gv_IOadd(gv);

+#ifndef PERL_EXTERNAL_GLOB
+    sv_setiv(GvSVn(gv),PL_glob_index++);
+#endif

     op_append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
     scalarkids(o);
     return o;
     op_append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
     scalarkids(o);
     return o;


@@ -8510,10 +8597,14 @@ Perl_ck_require(pTHX_ OP *o)
     }
 
     if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {
     }
 
     if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {

-       OP * const kid = cUNOPo->op_first;
-       OP * newop;
-
-       cUNOPo->op_first = 0;
+       OP *kid, *newop;
+       if (o->op_flags & OPf_KIDS) {
+           kid = cUNOPo->op_first;
+           cUNOPo->op_first = NULL;
+       }
+       else {
+           kid = newDEFSVOP();
+       }

 #ifndef PERL_MAD
        op_free(o);
 #endif
 #ifndef PERL_MAD
        op_free(o);
 #endif


@@ -8997,7 +9088,9 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
     PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_PROTO;
     if (SvTYPE(protosv) == SVt_PVCV ? !SvPOK(protosv) : !SvOK(protosv))
        Perl_croak(aTHX_ "panic: ck_entersub_args_proto CV with no proto");
     PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_PROTO;
     if (SvTYPE(protosv) == SVt_PVCV ? !SvPOK(protosv) : !SvOK(protosv))
        Perl_croak(aTHX_ "panic: ck_entersub_args_proto CV with no proto");

-    proto = SvPV(protosv, proto_len);
+    if (SvTYPE(protosv) == SVt_PVCV)
+        proto = CvPROTO(protosv), proto_len = CvPROTOLEN(protosv);
+    else proto = SvPV(protosv, proto_len);

     proto_end = proto + proto_len;
     aop = cUNOPx(entersubop)->op_first;
     if (!aop->op_sibling)
     proto_end = proto + proto_len;
     aop = cUNOPx(entersubop)->op_first;
     if (!aop->op_sibling)


@@ -9305,7 +9398,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
     }
     else {
        OP *prev, *cvop;
     }
     else {
        OP *prev, *cvop;

-       U32 paren;
+       U32 flags;

 #ifdef PERL_MAD
        bool seenarg = FALSE;
 #endif
 #ifdef PERL_MAD
        bool seenarg = FALSE;
 #endif


@@ -9324,16 +9417,20 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 #endif
            ;
        prev->op_sibling = NULL;
 #endif
            ;
        prev->op_sibling = NULL;

-       paren = OPf_SPECIAL * !(cvop->op_private & OPpENTERSUB_NOPAREN);
+       flags = OPf_SPECIAL * !(cvop->op_private & OPpENTERSUB_NOPAREN);

        op_free(cvop);
        if (aop == cvop) aop = NULL;
        op_free(entersubop);
 
        op_free(cvop);
        if (aop == cvop) aop = NULL;
        op_free(entersubop);
 

+       if (opnum == OP_ENTEREVAL
+        && GvNAMELEN(namegv)==9 && strnEQ(GvNAME(namegv), "evalbytes", 9))
+           flags |= OPpEVAL_BYTES <<8;
+       

        switch (PL_opargs[opnum] & OA_CLASS_MASK) {
        case OA_UNOP:
        case OA_BASEOP_OR_UNOP:
        case OA_FILESTATOP:
        switch (PL_opargs[opnum] & OA_CLASS_MASK) {
        case OA_UNOP:
        case OA_BASEOP_OR_UNOP:
        case OA_FILESTATOP:

-           return aop ? newUNOP(opnum,paren,aop) : newOP(opnum,paren);
+           return aop ? newUNOP(opnum,flags,aop) : newOP(opnum,flags);

        case OA_BASEOP:
            if (aop) {
 #ifdef PERL_MAD
        case OA_BASEOP:
            if (aop) {
 #ifdef PERL_MAD


@@ -9595,6 +9692,57 @@ Perl_ck_each(pTHX_ OP *o)
     return o->op_type == ref_type ? o : ck_fun(o);
 }
 
     return o->op_type == ref_type ? o : ck_fun(o);
 }
 

+OP *
+Perl_ck_length(pTHX_ OP *o)
+{
+    PERL_ARGS_ASSERT_CK_LENGTH;
+
+    o = ck_fun(o);
+
+    if (ckWARN(WARN_SYNTAX)) {
+        const OP *kid = o->op_flags & OPf_KIDS ? cLISTOPo->op_first : NULL;
+
+        if (kid) {
+            SV *name = NULL;
+            const bool hash = kid->op_type == OP_PADHV
+                           || kid->op_type == OP_RV2HV;
+            switch (kid->op_type) {
+                case OP_PADHV:
+                case OP_PADAV:
+                    name = varname(
+                        NULL, hash ? '%' : '@', kid->op_targ, NULL, 0, 1
+                    );
+                    break;
+                case OP_RV2HV:
+                case OP_RV2AV:
+                    if (cUNOPx(kid)->op_first->op_type != OP_GV) break;
+                    {
+                        GV *gv = cGVOPx_gv(cUNOPx(kid)->op_first);
+                        if (!gv) break;
+                        name = varname(gv, hash?'%':'@', 0, NULL, 0, 1);
+                    }
+                    break;
+                default:
+                    return o;
+            }
+            if (name)
+                Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+                    "length() used on %"SVf" (did you mean \"scalar(%s%"SVf
+                    ")\"?)",
+                    name, hash ? "keys " : "", name
+                );
+            else if (hash)
+                Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+                    "length() used on %%hash (did you mean \"scalar(keys %%hash)\"?)");
+            else
+                Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+                    "length() used on @array (did you mean \"scalar(@array)\"?)");
+        }
+    }
+
+    return o;
+}
+

 /* caller is supposed to assign the return to the 
    container of the rep_op var */
 STATIC OP *
 /* caller is supposed to assign the return to the 
    container of the rep_op var */
 STATIC OP *


@@ -9680,6 +9828,7 @@ S_inplace_aassign(pTHX_ OP *o) {
        if (oright->op_type != OP_RV2AV
            || !cUNOPx(oright)->op_first
            || cUNOPx(oright)->op_first->op_type != OP_GV
        if (oright->op_type != OP_RV2AV
            || !cUNOPx(oright)->op_first
            || cUNOPx(oright)->op_first->op_type != OP_GV

+           || cUNOPx(oleft )->op_first->op_type != OP_GV

            || cGVOPx_gv(cUNOPx(oleft)->op_first) !=
               cGVOPx_gv(cUNOPx(oright)->op_first)
        )
            || cGVOPx_gv(cUNOPx(oleft)->op_first) !=
               cGVOPx_gv(cUNOPx(oright)->op_first)
        )


@@ -10286,6 +10435,8 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code,
        retsetpvs("+;$$@", OP_SPLICE);
     case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__:
        retsetpvs("", 0);
        retsetpvs("+;$$@", OP_SPLICE);
     case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__:
        retsetpvs("", 0);

+    case KEY_evalbytes:
+       name = "entereval"; break;

     case KEY_readpipe:
        name = "backtick";
     }
     case KEY_readpipe:
        name = "backtick";
     }


@@ -10380,10 +10531,15 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
            return op_append_elem(
                        OP_LINESEQ, argop,
                        newOP(opnum,
            return op_append_elem(
                        OP_LINESEQ, argop,
                        newOP(opnum,

-                             opnum == OP_WANTARRAY ? OPpOFFBYONE << 8 : 0)
+                             opnum == OP_WANTARRAY || opnum == OP_RUNCV
+                               ? OPpOFFBYONE << 8 : 0)

                   );
        case OA_BASEOP_OR_UNOP:
                   );
        case OA_BASEOP_OR_UNOP:

-           o = newUNOP(opnum,0,argop);
+           if (opnum == OP_ENTEREVAL) {
+               o = newUNOP(OP_ENTEREVAL,OPpEVAL_COPHH<<8,argop);
+               if (code == -KEY_evalbytes) o->op_private |= OPpEVAL_BYTES;
+           }
+           else o = newUNOP(opnum,0,argop);

            if (opnum == OP_CALLER) o->op_private |= OPpOFFBYONE;
            else {
          onearg:
            if (opnum == OP_CALLER) o->op_private |= OPpOFFBYONE;
            else {
          onearg:


@@ -10406,6 +10562,45 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
     }
 }
 
     }
 }
 

+void
+Perl_report_redefined_cv(pTHX_ const SV *name, const CV *old_cv,
+                              SV * const *new_const_svp)
+{
+    const char *hvname;
+    bool is_const = !!CvCONST(old_cv);
+    SV *old_const_sv = is_const ? cv_const_sv(old_cv) : NULL;
+
+    PERL_ARGS_ASSERT_REPORT_REDEFINED_CV;
+
+    if (is_const && new_const_svp && old_const_sv == *new_const_svp)
+       return;
+       /* They are 2 constant subroutines generated from
+          the same constant. This probably means that
+          they are really the "same" proxy subroutine
+          instantiated in 2 places. Most likely this is
+          when a constant is exported twice.  Don't warn.
+       */
+    if (
+       (ckWARN(WARN_REDEFINE)
+        && !(
+               CvGV(old_cv) && GvSTASH(CvGV(old_cv))
+            && HvNAMELEN(GvSTASH(CvGV(old_cv))) == 7
+            && (hvname = HvNAME(GvSTASH(CvGV(old_cv))),
+                strEQ(hvname, "autouse"))
+            )
+       )
+     || (is_const
+        && ckWARN_d(WARN_REDEFINE)
+        && (!new_const_svp || sv_cmp(old_const_sv, *new_const_svp))
+       )
+    )
+       Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
+                         is_const
+                           ? "Constant subroutine %"SVf" redefined"
+                           : "Subroutine %"SVf" redefined",
+                         name);
+}
+

 #include "XSUB.h"
 
 /* Efficient sub that returns a constant scalar value. */
 #include "XSUB.h"
 
 /* Efficient sub that returns a constant scalar value. */