This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Various updates and fixes to some of the SysV IPC ops and their tests
[perl5.git] / gv.c
diff --git a/gv.c b/gv.c
index b3b9f7f..e849d0f 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -20,7 +20,7 @@
  */
 
 /*
-=head1 GV Functions
+=head1 GV Handling
 A GV is a structure which corresponds to to a Perl typeglob, ie *foo.
 It is a structure that holds a pointer to a scalar, an array, a hash etc,
 corresponding to $foo, @foo, %foo.
@@ -28,6 +28,8 @@ corresponding to $foo, @foo, %foo.
 GVs are usually found as values in stashes (symbol table hashes) where
 Perl stores its global variables.
 
+=for apidoc Ayh||GV
+
 =cut
 */
 
@@ -83,8 +85,8 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)
     if (!*where)
     {
        *where = newSV_type(type);
-           if (type == SVt_PVAV && GvNAMELEN(gv) == 3
-            && strEQs(GvNAME(gv), "ISA"))
+           if (type == SVt_PVAV
+            && memEQs(GvNAME(gv), GvNAMELEN(gv), "ISA"))
            sv_magic(*where, (SV *)gv, PERL_MAGIC_isa, NULL, 0);
     }
     return gv;
@@ -168,7 +170,6 @@ Perl_newGP(pTHX_ GV *const gv)
 #ifndef USE_ITHREADS
     GV *filegv;
 #endif
-    dVAR;
 
     PERL_ARGS_ASSERT_NEWGP;
     Newxz(gp, 1, GP);
@@ -323,6 +324,8 @@ the return value of SvUTF8(sv).  It can also take the
 C<GV_ADDMULTI> flag, which means to pretend that the GV has been
 seen before (i.e., suppress "Used once" warnings).
 
+=for apidoc Amnh||GV_ADDMULTI
+
 =for apidoc gv_init
 
 The old form of C<gv_init_pvn()>.  It does not work with UTF-8 strings, as it
@@ -525,9 +528,10 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
     case KEY_do      : case KEY_dump   : case KEY_else  : case KEY_elsif  :
     case KEY_END     : case KEY_eq     : case KEY_eval  :
     case KEY_for     : case KEY_foreach: case KEY_format: case KEY_ge     :
-    case KEY_given   : case KEY_goto   : case KEY_grep  :
-    case KEY_gt   : case KEY_if: case KEY_INIT: case KEY_last: case KEY_le:
-    case KEY_local: case KEY_lt: case KEY_m   : case KEY_map : case KEY_my:
+    case KEY_given   : case KEY_goto   : case KEY_grep  : case KEY_gt     :
+    case KEY_if      : case KEY_isa    : case KEY_INIT  : case KEY_last   :
+    case KEY_le      : case KEY_local  : case KEY_lt    : case KEY_m      :
+    case KEY_map     : case KEY_my:
     case KEY_ne   : case KEY_next : case KEY_no: case KEY_or: case KEY_our:
     case KEY_package: case KEY_print: case KEY_printf:
     case KEY_q    : case KEY_qq   : case KEY_qr     : case KEY_qw    :
@@ -693,6 +697,8 @@ visible to Perl code.  So when calling C<call_sv>, you should not use
 the GV directly; instead, you should use the method's CV, which can be
 obtained from the GV with the C<GvCV> macro.
 
+=for apidoc Amnh||GV_SUPER
+
 =cut
 */
 
@@ -711,6 +717,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
     CV* cand_cv = NULL;
     GV* topgv = NULL;
     const char *hvname;
+    STRLEN hvnamelen;
     I32 create = (level >= 0) ? HV_FETCH_LVALUE : 0;
     I32 items;
     U32 topgen_cmp;
@@ -726,6 +733,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
     assert(stash);
 
     hvname = HvNAME_get(stash);
+    hvnamelen = HvNAMELEN_get(stash);
     if (!hvname)
       Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
 
@@ -780,8 +788,8 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
             return 0;
         }
        else if (stash == cachestash
-             && len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4
-              && strEQs(hvname, "CORE")
+             && len > 1 /* shortest is uc */
+              && memEQs(hvname, HvNAMELEN_get(stash), "CORE")
               && S_maybe_add_coresub(aTHX_ NULL,topgv,name,len))
            goto have_gv;
     }
@@ -795,20 +803,42 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
         cstash = gv_stashsv(linear_sv, 0);
 
         if (!cstash) {
-           Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
-                           "Can't locate package %" SVf " for @%" HEKf "::ISA",
-                          SVfARG(linear_sv),
-                           HEKfARG(HvNAME_HEK(stash)));
+            if ( ckWARN(WARN_SYNTAX)) {
+                if(     /* these are loaded from Perl_Gv_AMupdate() one way or another */
+                           ( len    && name[0] == '(' )  /* overload.pm related, in particular "()" */
+                        || ( memEQs( name, len, "DESTROY") )
+                ) {
+                     Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                            "Can't locate package %" SVf " for @%" HEKf "::ISA",
+                            SVfARG(linear_sv),
+                            HEKfARG(HvNAME_HEK(stash)));
+
+                } else if( memEQs( name, len, "AUTOLOAD") ) {
+                    /* gobble this warning */
+                } else {
+                    Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                        "While trying to resolve method call %.*s->%.*s()"
+                        " can not locate package \"%" SVf "\" yet it is mentioned in @%.*s::ISA"
+                        " (perhaps you forgot to load \"%" SVf "\"?)",
+                         (int) hvnamelen, hvname,
+                         (int) len, name,
+                        SVfARG(linear_sv),
+                         (int) hvnamelen, hvname,
+                         SVfARG(linear_sv));
+                }
+            }
             continue;
         }
 
         assert(cstash);
 
-        gvp = (GV**)hv_fetch(cstash, name, is_utf8 ? -(I32)len : (I32)len, 0);
+        gvp = (GV**)hv_common(
+            cstash, meth, name, len, is_utf8 ? HVhek_UTF8 : 0, HV_FETCH_JUST_SV, NULL, 0
+        );
         if (!gvp) {
             if (len > 1 && HvNAMELEN_get(cstash) == 4) {
                 const char *hvname = HvNAME(cstash); assert(hvname);
-                if (strEQs(hvname, "CORE")
+                if (strBEGINs(hvname, "CORE")
                  && (candidate =
                       S_maybe_add_coresub(aTHX_ cstash,NULL,name,len)
                     ))
@@ -1074,7 +1104,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
                         origname, HvENAME_get(stash), name) );
        }
         else if ( sep_len >= 7 &&
-                strEQs(last_separator - 7, "::SUPER")) {
+                strBEGINs(last_separator - 7, "::SUPER")) {
             /* don't autovifify if ->NoSuchStash::SUPER::method */
             stash = gv_stashpvn(origname, sep_len - 7, is_utf8);
            if (stash) flags |= GV_SUPER;
@@ -1091,9 +1121,10 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
        /* This is the special case that exempts Foo->import and
           Foo->unimport from being an error even if there's no
          import/unimport subroutine */
-       if (strEQ(name,"import") || strEQ(name,"unimport"))
-           gv = MUTABLE_GV(&PL_sv_yes);
-       else if (autoload)
+       if (strEQ(name,"import") || strEQ(name,"unimport")) {
+           gv = (GV*)sv_2mortal((SV*)newCONSTSUB_flags(NULL,
+                                               NULL, 0, 0, NULL));
+       } else if (autoload)
            gv = gv_autoload_pvn(
                ostash, name, name_end - name, GV_AUTOLOAD_ISMETHOD|flags
            );
@@ -1263,7 +1294,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
            if (SvUTF8(cv))
                sv_utf8_upgrade_flags_grow(tmpsv, 0, CvPROTOLEN(cv) + 2);
            ulen = SvCUR(tmpsv);
-           SvCUR(tmpsv)++; /* include null in string */
+           SvCUR_set(tmpsv, SvCUR(tmpsv) + 1); /* include null in string */
            sv_catpvn_flags(
                tmpsv, proto, CvPROTOLEN(cv), SV_CATBYTES*!SvUTF8(cv)
            );
@@ -1271,8 +1302,8 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
            sv_setsv_nomg((SV *)cv, tmpsv);
            SvTEMP_off(tmpsv);
            SvREFCNT_dec_NN(tmpsv);
-           SvLEN(cv) = SvCUR(cv) + 1;
-           SvCUR(cv) = ulen;
+           SvLEN_set(cv, SvCUR(cv) + 1);
+           SvCUR_set(cv, ulen);
        }
        else {
          sv_setpvn((SV *)cv, name, len);
@@ -1433,6 +1464,13 @@ The most important of which are probably C<GV_ADD> and C<SVf_UTF8>.
 Note, use of C<gv_stashsv> instead of C<gv_stashpvn> where possible is strongly
 recommended for performance reasons.
 
+=for apidoc Amnh||GV_ADD
+=for apidoc Amnh||GV_NOADD_NOINIT
+=for apidoc Amnh||GV_NOINIT
+=for apidoc Amnh||GV_NOEXPAND
+=for apidoc Amnh||GV_ADDMG
+=for apidoc Amnh||SVf_UTF8
+
 =cut
 */
 
@@ -1486,11 +1524,11 @@ S_gv_stashpvn_internal(pTHX_ const char *name, U32 namelen, I32 flags)
 gv_stashsvpvn_cached
 
 Returns a pointer to the stash for a specified package, possibly
-cached.  Implements both C<gv_stashpvn> and C<gv_stashsv>.
+cached.  Implements both C<L</gv_stashpvn>> and C<L</gv_stashsv>>.
 
-Requires one of either namesv or namepv to be non-null.
+Requires one of either C<namesv> or C<namepv> to be non-null.
 
-See C<L</gv_stashpvn>> for details on "flags".
+See C<L</gv_stashpvn>> for details on C<flags>.
 
 Note the sv interface is strongly preferred for performance reasons.
 
@@ -1499,8 +1537,8 @@ Note the sv interface is strongly preferred for performance reasons.
 #define PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED \
     assert(namesv || name)
 
-PERL_STATIC_INLINE HV*
-S_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 flags)
+HV*
+Perl_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 flags)
 {
     HV* stash;
     HE* he;
@@ -1568,12 +1606,10 @@ Perl_gv_stashsv(pTHX_ SV *sv, I32 flags)
     PERL_ARGS_ASSERT_GV_STASHSV;
     return gv_stashsvpvn_cached(sv, NULL, 0, flags);
 }
-
-
 GV *
-Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, const svtype sv_type) {
+Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 flags, const svtype sv_type) {
     PERL_ARGS_ASSERT_GV_FETCHPV;
-    return gv_fetchpvn_flags(nambeg, strlen(nambeg), add, sv_type);
+    return gv_fetchpvn_flags(nambeg, strlen(nambeg), flags, sv_type);
 }
 
 GV *
@@ -1633,7 +1669,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
             if (!*stash)
                 *stash = PL_defstash;
             if (!*stash || !SvREFCNT(*stash)) /* symbol table under destruction */
-                return FALSE;
+                goto notok;
 
             *len = name_cursor - *name;
             if (name_cursor > nambeg) { /* Skip for initial :: or ' */
@@ -1662,8 +1698,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                 gvp = (GV**)hv_fetch(*stash, key, is_utf8 ? -((I32)*len) : (I32)*len, add);
                 *gv = gvp ? *gvp : NULL;
                 if (!*gv || *gv == (const GV *)&PL_sv_undef) {
-                    Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
-                    return FALSE;
+                    goto notok;
                 }
                 /* here we know that *gv && *gv != &PL_sv_undef */
                 if (SvTYPE(*gv) != SVt_PVGV)
@@ -1675,7 +1710,7 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                     *stash = GvHV(*gv) = newHV();
                     if (!HvNAME_get(*stash)) {
                         if (GvSTASH(*gv) == PL_defstash && *len == 6
-                            && strEQs(*name, "CORE"))
+                            && strBEGINs(*name, "CORE"))
                             hv_name_sets(*stash, "CORE", 0);
                         else
                             hv_name_set(
@@ -1704,15 +1739,20 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                            MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
                    }
                }
-                Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
-                return TRUE;
+                goto ok;
             }
         }
     }
     *len = name_cursor - *name;
+  ok:
+    Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
     return TRUE;
+  notok:
+    Safefree(tmpfullbuf); /* free our tmpfullbuf if it was used */
+    return FALSE;
 }
 
+
 /* Checks if an unqualified name is in the main stash */
 PERL_STATIC_INLINE bool
 S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8)
@@ -1877,7 +1917,7 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len,
  * a new GV.
  * Note that it does not insert the GV into the stash prior to
  * magicalization, which some variables require need in order
- * to work (like $[, %+, %-, %!), so callers must take care of
+ * to work (like %+, %-, %!), so callers must take care of
  * that.
  * 
  * It returns true if the gv did turn out to be magical one; i.e.,
@@ -1934,7 +1974,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
        if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4) {
          /* Avoid null warning: */
          const char * const stashname = HvNAME(stash); assert(stashname);
-         if (strEQs(stashname, "CORE"))
+         if (strBEGINs(stashname, "CORE"))
            S_maybe_add_coresub(aTHX_ 0, gv, name, len);
        }
     }
@@ -2025,13 +2065,11 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
                     sv_magic(MUTABLE_SV(av), (SV*)n, PERL_MAGIC_regdata, NULL, 0);
                     SvREADONLY_on(av);
 
-                    if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-                        require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0);
+                    require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0);
 
                 } else          /* %{^CAPTURE_ALL} */
                 if (memEQs(name, len, "\003APTURE_ALL")) {
-                    if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-                        require_tie_mod_s(gv, '+', "Tie::Hash::NamedCapture",0);
+                    require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0);
                 }
                break;
            case '\005':        /* $^ENCODING */
@@ -2066,6 +2104,10 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
                     goto storeparen;
                 }
                break;
+            case '\023':
+                if (memEQs(name, len, "\023AFE_LOCALES"))
+                   goto ro_magicalize;
+               break;
            case '\024':        /* ${^TAINT} */
                 if (memEQs(name, len, "\024AINT"))
                    goto ro_magicalize;
@@ -2196,25 +2238,16 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
             break;
        case '*':               /* $* */
        case '#':               /* $# */
-           if (sv_type == SVt_PV)
-               /* diag_listed_as: $* is no longer supported. Its use will be fatal in Perl 5.30 */
-               Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                                "$%c is no longer supported. Its use "
-                                 "will be fatal in Perl 5.30", *name);
-           break;
+        if (sv_type == SVt_PV)
+            /* diag_listed_as: $* is no longer supported as of Perl 5.30 */
+            Perl_croak(aTHX_ "$%c is no longer supported as of Perl 5.30", *name);
+        break;
        case '\010':    /* $^H */
            {
                HV *const hv = GvHVn(gv);
                hv_magic(hv, NULL, PERL_MAGIC_hints);
            }
            goto magicalize;
-       case '[':               /* $[ */
-           if ((sv_type == SVt_PV || sv_type == SVt_PVGV)
-            && FEATURE_ARYBASE_IS_ENABLED) {
-                require_tie_mod_s(gv,'[',"arybase",0);
-           }
-           else goto magicalize;
-            break;
        case '\023':    /* $^S */
        ro_magicalize:
            SvREADONLY_on(GvSVn(gv));
@@ -2233,6 +2266,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
        case '/':               /* $/ */
        case '|':               /* $| */
        case '$':               /* $$ */
+       case '[':               /* $[ */
        case '\001':    /* $^A */
        case '\003':    /* $^C */
        case '\004':    /* $^D */
@@ -2310,18 +2344,12 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type)
             require_tie_mod_s(gv, *name, "Tie::Hash::NamedCapture", 0);
     } else if (sv_type == SVt_PV) {
         if (*name == '*' || *name == '#') {
-            /* diag_listed_as: $# is no longer supported. Its use will be fatal in Perl 5.30 */
-            Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED,
-                                             WARN_SYNTAX),
-                             "$%c is no longer supported. Its use "
-                             "will be fatal in Perl 5.30", *name);
+            /* diag_listed_as: $* is no longer supported as of Perl 5.30 */
+            Perl_croak(aTHX_ "$%c is no longer supported as of Perl 5.30", *name);
         }
     }
     if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
       switch (*name) {
-      case '[':
-          require_tie_mod_s(gv,'[',"arybase",0);
-          break;
 #ifdef PERL_SAWAMPERSAND
       case '`':
           PL_sawampersand |= SAWAMPERSAND_LEFT;
@@ -2340,6 +2368,75 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type)
     }
 }
 
+/*
+=for apidoc gv_fetchpv
+=for apidoc_item |GV *|gv_fetchpvn|const char * nambeg|STRLEN full_len|I32 flags|const svtype sv_type
+=for apidoc_item ||gv_fetchpvn_flags
+=for apidoc_item |GV *|gv_fetchpvs|"name"|I32 flags|const svtype sv_type
+=for apidoc_item ||gv_fetchsv
+=for apidoc_item |GV *|gv_fetchsv_nomg|SV *name|I32 flags|const svtype sv_type
+
+These all return the GV of type C<sv_type> whose name is given by the inputs,
+or NULL if no GV of that name and type could be found.  See L<perlguts/Stashes
+and Globs>.
+
+The only differences are how the input name is specified, and if 'get' magic is
+normally used in getting that name.
+
+Don't be fooled by the fact that only one form has C<flags> in its name.  They
+all have a C<flags> parameter in fact, and all the flag bits have the same
+meanings for all
+
+If any of the flags C<GV_ADD>, C<GV_ADDMG>, C<GV_ADDWARN>, C<GV_ADDMULTI>, or
+C<GV_NOINIT> is set, a GV is created if none already exists for the input name
+and type.  However, C<GV_ADDMG> will only do the creation for magical GV's.
+For all of these flags except C<GV_NOINIT>, C<L</gv_init_pvn>> is called after
+the addition.  C<GV_ADDWARN> is used when the caller expects that adding won't
+be necessary because the symbol should already exist; but if not, add it
+anyway, with a warning that it was unexpectedly absent.  The C<GV_ADDMULTI>
+flag means to pretend that the GV has been seen before (I<i.e.>, suppress "Used
+once" warnings).
+
+The flag C<GV_NOADD_NOINIT> causes C<L</gv_init_pvn>> not be to called if the
+GV existed but isn't PVGV.
+
+If the C<SVf_UTF8> bit is set, the name is treated as being encoded in UTF-8;
+otherwise the name won't be considered to be UTF-8 in the C<pv>-named forms,
+and the UTF-8ness of the underlying SVs will be used in the C<sv> forms.
+
+If the flag C<GV_NOTQUAL> is set, the caller warrants that the input name is a
+plain symbol name, not qualified with a package, otherwise the name is checked
+for being a qualified one.
+
+In C<gv_fetchpv>, C<nambeg> is a C string, NUL-terminated with no intermediate
+NULs.
+
+In C<gv_fetchpvs>, C<name> is a literal C string, hence is enclosed in
+double quotes.
+
+C<gv_fetchpvn> and C<gv_fetchpvn_flags> are identical.  In these, <nambeg> is
+a Perl string whose byte length is given by C<full_len>, and may contain
+embedded NULs.
+
+In C<gv_fetchsv> and C<gv_fetchsv_nomg>, the name is extracted from the PV of
+the input C<name> SV.  The only difference between these two forms is that
+'get' magic is normally done on C<name> in C<gv_fetchsv>, and always skipped
+with C<gv_fetchsv_nomg>.  Including C<GV_NO_SVGMAGIC> in the C<flags> parameter
+to C<gv_fetchsv> makes it behave identically to C<gv_fetchsv_nomg>.
+
+=for apidoc Amnh||GV_ADD
+=for apidoc Amnh||GV_ADDMG
+=for apidoc Amnh||GV_ADDMULTI
+=for apidoc Amnh||GV_ADDWARN
+=for apidoc Amnh||GV_NOADD_NOINIT
+=for apidoc Amnh||GV_NOINIT
+=for apidoc Amnh||GV_NOTQUAL
+=for apidoc Amnh||GV_NO_SVGMAGIC
+=for apidoc Amnh||SVf_UTF8
+
+=cut
+*/
+
 GV *
 Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                       const svtype sv_type)
@@ -2381,7 +2478,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     /* By this point we should have a stash and a name */
     gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -(I32)len : (I32)len,add);
     if (!gvp || *gvp == (const GV *)&PL_sv_undef) {
-       if (addmg) gv = (GV *)newSV(0);
+       if (addmg) gv = (GV *)newSV(0);     /* tentatively */
        else return NULL;
     }
     else gv = *gvp, addmg = 0;
@@ -2410,8 +2507,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
            if (len == 1 && stash == PL_defstash) {
                 maybe_multimagic_gv(gv, name, sv_type);
            }
-           else if (len == 3 && sv_type == SVt_PVAV
-                 && strEQs(name, "ISA")
+            else if (sv_type == SVt_PVAV
+                 && memEQs(name, len, "ISA")
                  && (!GvAV(gv) || !SvSMAGICAL(GvAV(gv))))
                gv_magicalize_isa(gv);
        }
@@ -2487,7 +2584,7 @@ Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
 
     if (hv && (name = HvNAME(hv))) {
       const STRLEN len = HvNAMELEN(hv);
-      if (keepmain || strnNE(name, "main", len)) {
+      if (keepmain || ! memBEGINs(name, len, "main")) {
        sv_catpvn_flags(sv,name,len,HvNAMEUTF8(hv)?SV_CATUTF8:SV_CATBYTES);
        sv_catpvs(sv,"::");
       }
@@ -2816,9 +2913,9 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
             const HEK * const gvhek = CvGvNAME_HEK(cv);
             const HEK * const stashek =
                 HvNAME_HEK(CvNAMED(cv) ? CvSTASH(cv) : GvSTASH(CvGV(cv)));
-            if (HEK_LEN(gvhek) == 3 && strEQ(HEK_KEY(gvhek), "nil")
-             && stashek && HEK_LEN(stashek) == 8
-             && strEQ(HEK_KEY(stashek), "overload")) {
+            if (memEQs(HEK_KEY(gvhek), HEK_LEN(gvhek), "nil")
+             && stashek
+             && memEQs(HEK_KEY(stashek), HEK_LEN(stashek), "overload")) {
                /* This is a hack to support autoloading..., while
                   knowing *which* methods were declared as overloaded. */
                /* GvSV contains the name of the method. */
@@ -2945,8 +3042,6 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
 /* Implement tryAMAGICun_MG macro.
    Do get magic, then see if the stack arg is overloaded and if so call it.
    Flags:
-       AMGf_set     return the arg using SETs rather than assigning to
-                    the targ
        AMGf_numeric apply sv_2num to the stack arg.
 */
 
@@ -2962,18 +3057,21 @@ Perl_try_amagic_un(pTHX_ int method, int flags) {
                                              AMGf_noright | AMGf_unary
                                            | (flags & AMGf_numarg))))
     {
-       if (flags & AMGf_set) {
-           SETs(tmpsv);
-       }
-       else {
-           dTARGET;
-           if (SvPADMY(TARG)) {
-               sv_setsv(TARG, tmpsv);
-               SETTARG;
-           }
-           else
-               SETs(tmpsv);
-       }
+        /* where the op is of the form:
+         *    $lex = $x op $y (where the assign is optimised away)
+         * then assign the returned value to targ and return that;
+         * otherwise return the value directly
+         */
+        if (   (PL_opargs[PL_op->op_type] & OA_TARGLEX)
+            && (PL_op->op_private & OPpTARGET_MY))
+        {
+            dTARGET;
+            sv_setsv(TARG, tmpsv);
+            SETTARG;
+        }
+        else
+            SETs(tmpsv);
+
        PUTBACK;
        return TRUE;
     }
@@ -2988,8 +3086,6 @@ Perl_try_amagic_un(pTHX_ int method, int flags) {
    Do get magic, then see if the two stack args are overloaded and if so
    call it.
    Flags:
-       AMGf_set     return the arg using SETs rather than assigning to
-                    the targ
        AMGf_assign  op may be called as mutator (eg +=)
        AMGf_numeric apply sv_2num to the stack arg.
 */
@@ -3005,28 +3101,38 @@ Perl_try_amagic_bin(pTHX_ int method, int flags) {
        SvGETMAGIC(right);
 
     if (SvAMAGIC(left) || SvAMAGIC(right)) {
-       SV * const tmpsv = amagic_call(left, right, method,
-                   ((flags & AMGf_assign) && opASSIGN ? AMGf_assign: 0)
+       SV * tmpsv;
+        /* STACKED implies mutator variant, e.g. $x += 1 */
+        bool mutator = (flags & AMGf_assign) && (PL_op->op_flags & OPf_STACKED);
+
+       tmpsv = amagic_call(left, right, method,
+                   (mutator ? AMGf_assign: 0)
                  | (flags & AMGf_numarg));
        if (tmpsv) {
-           if (flags & AMGf_set) {
-               (void)POPs;
-               SETs(tmpsv);
-           }
-           else {
-               dATARGET;
-               (void)POPs;
-               if (opASSIGN || SvPADMY(TARG)) {
-                   sv_setsv(TARG, tmpsv);
-                   SETTARG;
-               }
-               else
-                   SETs(tmpsv);
-           }
+            (void)POPs;
+            /* where the op is one of the two forms:
+             *    $x op= $y
+             *    $lex = $x op $y (where the assign is optimised away)
+             * then assign the returned value to targ and return that;
+             * otherwise return the value directly
+             */
+            if (   mutator
+                || (   (PL_opargs[PL_op->op_type] & OA_TARGLEX)
+                    && (PL_op->op_private & OPpTARGET_MY)))
+            {
+                dTARG;
+                TARG = mutator ? *SP : PAD_SV(PL_op->op_targ);
+                sv_setsv(TARG, tmpsv);
+                SETTARG;
+            }
+            else
+                SETs(tmpsv);
+
            PUTBACK;
            return TRUE;
        }
     }
+
     if(left==right && SvGMAGICAL(left)) {
        SV * const left = sv_newmortal();
        *(sp-1) = left;
@@ -3106,7 +3212,6 @@ Perl_amagic_is_enabled(pTHX_ int method)
 SV*
 Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 {
-  dVAR;
   MAGIC *mg;
   CV *cv=NULL;
   CV **cvp=NULL, **ocvp=NULL;
@@ -3476,7 +3581,12 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     SV* res;
     const bool oldcatch = CATCH_GET;
     I32 oldmark, nret;
-    U8 gimme = force_scalar ? G_SCALAR : GIMME_V;
+                /* for multiconcat, we may call overload several times,
+                 * with the context of individual concats being scalar,
+                 * regardless of the overall context of the multiconcat op
+                 */
+    U8 gimme = (force_scalar || PL_op->op_type == OP_MULTICONCAT)
+                    ? G_SCALAR : GIMME_V;
 
     CATCH_SET(TRUE);
     Zero(&myop, 1, BINOP);
@@ -3599,7 +3709,6 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 void
 Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
 {
-    dVAR;
     U32 hash;
 
     PERL_ARGS_ASSERT_GV_NAME_SET;