This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix special-case recreation of *::
[perl5.git] / gv.c
diff --git a/gv.c b/gv.c
index e24a193..ae800c9 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -84,7 +84,7 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)
     {
        *where = newSV_type(type);
            if (type == SVt_PVAV && GvNAMELEN(gv) == 3
-            && strnEQ(GvNAME(gv), "ISA", 3))
+            && strEQs(GvNAME(gv), "ISA"))
            sv_magic(*where, (SV *)gv, PERL_MAGIC_isa, NULL, 0);
     }
     return gv;
@@ -770,7 +770,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
         }
        else if (stash == cachestash
              && len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4
-              && strnEQ(hvname, "CORE", 4)
+              && strEQs(hvname, "CORE")
               && S_maybe_add_coresub(aTHX_ NULL,topgv,name,len))
            goto have_gv;
     }
@@ -785,7 +785,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
 
         if (!cstash) {
            Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
-                           "Can't locate package %"SVf" for @%"HEKf"::ISA",
+                           "Can't locate package %" SVf " for @%" HEKf "::ISA",
                           SVfARG(linear_sv),
                            HEKfARG(HvNAME_HEK(stash)));
             continue;
@@ -797,7 +797,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
         if (!gvp) {
             if (len > 1 && HvNAMELEN_get(cstash) == 4) {
                 const char *hvname = HvNAME(cstash); assert(hvname);
-                if (strnEQ(hvname, "CORE", 4)
+                if (strEQs(hvname, "CORE")
                  && (candidate =
                       S_maybe_add_coresub(aTHX_ cstash,NULL,name,len)
                     ))
@@ -1003,16 +1003,14 @@ Perl_gv_fetchmethod_pv_flags(pTHX_ HV *stash, const char *name, U32 flags)
     return gv_fetchmethod_pvn_flags(stash, name, strlen(name), flags);
 }
 
-/* Don't merge this yet, as it's likely to get a len parameter, and possibly
-   even a U32 hash */
 GV *
 Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN len, U32 flags)
 {
-    const char *nend;
-    const char *nsplit = NULL;
+    const char * const origname = name;
+    const char * const name_end = name + len;
+    const char *last_separator = NULL;
     GV* gv;
     HV* ostash = stash;
-    const char * const origname = name;
     SV *const error_report = MUTABLE_SV(stash);
     const U32 autoload = flags & GV_AUTOLOAD;
     const U32 do_croak = flags & GV_CROAK;
@@ -1023,43 +1021,61 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
     if (SvTYPE(stash) < SVt_PVHV)
        stash = NULL;
     else {
-       /* The only way stash can become NULL later on is if nsplit is set,
+       /* The only way stash can become NULL later on is if last_separator is set,
           which in turn means that there is no need for a SVt_PVHV case
           the error reporting code.  */
     }
 
-    for (nend = name; *nend || nend != (origname + len); nend++) {
-       if (*nend == '\'') {
-           nsplit = nend;
-           name = nend + 1;
-       }
-       else if (*nend == ':' && *(nend + 1) == ':') {
-           nsplit = nend++;
-           name = nend + 1;
-       }
+    {
+        /* check if the method name is fully qualified or
+         * not, and separate the package name from the actual
+         * method name.
+         *
+         * leaves last_separator pointing to the beginning of the
+         * last package separator (either ' or ::) or 0
+         * if none was found.
+         *
+         * leaves name pointing at the beginning of the
+         * method name.
+         */
+        const char *name_cursor = name;
+        const char * const name_em1 = name_end - 1; /* name_end minus 1 */
+        for (name_cursor = name; name_cursor < name_end ; name_cursor++) {
+            if (*name_cursor == '\'') {
+                last_separator = name_cursor;
+                name = name_cursor + 1;
+            }
+            else if (name_cursor < name_em1 && *name_cursor == ':' && name_cursor[1] == ':') {
+                last_separator = name_cursor++;
+                name = name_cursor + 1;
+            }
+        }
     }
-    if (nsplit) {
-       if ((nsplit - origname) == 5 && memEQ(origname, "SUPER", 5)) {
+
+    /* did we find a separator? */
+    if (last_separator) {
+        STRLEN sep_len= last_separator - origname;
+        if ( memEQs(origname, sep_len, "SUPER")) {
            /* ->SUPER::method should really be looked up in original stash */
            stash = CopSTASH(PL_curcop);
            flags |= GV_SUPER;
            DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
                         origname, HvENAME_get(stash), name) );
        }
-       else if ((nsplit - origname) >= 7 &&
-                strnEQ(nsplit - 7, "::SUPER", 7)) {
+        else if ( sep_len >= 7 &&
+                strEQs(last_separator - 7, "::SUPER")) {
             /* don't autovifify if ->NoSuchStash::SUPER::method */
-           stash = gv_stashpvn(origname, nsplit - origname - 7, is_utf8);
+            stash = gv_stashpvn(origname, sep_len - 7, is_utf8);
            if (stash) flags |= GV_SUPER;
        }
        else {
             /* don't autovifify if ->NoSuchStash::method */
-            stash = gv_stashpvn(origname, nsplit - origname, is_utf8);
+            stash = gv_stashpvn(origname, sep_len, is_utf8);
        }
        ostash = stash;
     }
 
-    gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, flags);
+    gv = gv_fetchmeth_pvn(stash, name, name_end - name, 0, flags);
     if (!gv) {
        /* This is the special case that exempts Foo->import and
           Foo->unimport from being an error even if there's no
@@ -1068,7 +1084,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
            gv = MUTABLE_GV(&PL_sv_yes);
        else if (autoload)
            gv = gv_autoload_pvn(
-               ostash, name, nend - name, GV_AUTOLOAD_ISMETHOD|flags
+               ostash, name, name_end - name, GV_AUTOLOAD_ISMETHOD|flags
            );
        if (!gv && do_croak) {
            /* Right now this is exclusively for the benefit of S_method_common
@@ -1084,31 +1100,31 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
                                       HV_FETCH_ISEXISTS, NULL, 0)
                ) {
                    require_pv("IO/File.pm");
-                   gv = gv_fetchmeth_pvn(stash, name, nend - name, 0, flags);
+                   gv = gv_fetchmeth_pvn(stash, name, name_end - name, 0, flags);
                    if (gv)
                        return gv;
                }
                Perl_croak(aTHX_
-                          "Can't locate object method \"%"UTF8f
-                          "\" via package \"%"HEKf"\"",
-                                   UTF8fARG(is_utf8, nend - name, name),
+                          "Can't locate object method \"%" UTF8f
+                          "\" via package \"%" HEKf "\"",
+                                   UTF8fARG(is_utf8, name_end - name, name),
                                     HEKfARG(HvNAME_HEK(stash)));
            }
            else {
                 SV* packnamesv;
 
-               if (nsplit) {
-                   packnamesv = newSVpvn_flags(origname, nsplit - origname,
+               if (last_separator) {
+                   packnamesv = newSVpvn_flags(origname, last_separator - origname,
                                                     SVs_TEMP | is_utf8);
                } else {
                    packnamesv = error_report;
                }
 
                Perl_croak(aTHX_
-                          "Can't locate object method \"%"UTF8f
-                          "\" via package \"%"SVf"\""
-                          " (perhaps you forgot to load \"%"SVf"\"?)",
-                          UTF8fARG(is_utf8, nend - name, name),
+                          "Can't locate object method \"%" UTF8f
+                          "\" via package \"%" SVf "\""
+                          " (perhaps you forgot to load \"%" SVf "\"?)",
+                          UTF8fARG(is_utf8, name_end - name, name),
                            SVfARG(packnamesv), SVfARG(packnamesv));
            }
        }
@@ -1200,8 +1216,9 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
      && (GvCVGEN(gv) || GvSTASH(gv) != stash)
     )
        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                        "Use of inherited AUTOLOAD for non-method %"SVf
-                        "::%"UTF8f"() is deprecated",
+                        "Use of inherited AUTOLOAD for non-method %" SVf
+                        "::%" UTF8f "() is deprecated. This will be "
+                         "fatal in Perl 5.28",
                         SVfARG(packname),
                          UTF8fARG(is_utf8, len, name));
 
@@ -1298,19 +1315,16 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
  * with the passed gv as an argument.
  *
  * The "gv" parameter should be the glob.
- * "varpv" holds the name of the var, used for error messages.
+ * "varname" holds the 1-char name of the var, used for error messages.
  * "namesv" holds the module name. Its refcount will be decremented.
  * "flags": if flag & 1 then save the scalar before loading.
  * For the protection of $! to work (it is set by this routine)
  * the sv slot must already be magicalized.
  */
 STATIC void
-S_require_tie_mod(pTHX_ GV *gv, const char *varpv, const char * name,
+S_require_tie_mod(pTHX_ GV *gv, const char varname, const char * name,
                         STRLEN len, const U32 flags)
 {
-    const char varname = *varpv; /* varpv might be clobbered by
-                                    load_module, so save it.  For the
-                                    moment it’s always a single char.  */
     const SV * const target = varname == '[' ? GvSV(gv) : (SV *)GvHV(gv);
 
     PERL_ARGS_ASSERT_REQUIRE_TIE_MOD;
@@ -1326,7 +1340,7 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, const char * name,
 
       ENTER;
 
-#define HV_FETCH_TIE_FUNC (GV **)hv_fetch(stash, "_tie_it", 7, 0)
+#define HV_FETCH_TIE_FUNC (GV **)hv_fetchs(stash, "_tie_it", 0)
 
       /* Load the module if it is not loaded.  */
       if (!(stash = gv_stashpvn(name, len, 0))
@@ -1356,6 +1370,13 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, const char * name,
     }
 }
 
+/* add a require_tie_mod_s - the _s suffix is similar to pvs type suffixes,
+ * IOW it means we do STR_WITH_LEN() ourselves and the user should pass in
+ * a true string WITHOUT a len.
+ */
+#define require_tie_mod_s(gv, varname, name, flags) \
+    S_require_tie_mod(aTHX_ gv, varname, STR_WITH_LEN(name), flags)
+
 /*
 =for apidoc gv_stashpv
 
@@ -1571,7 +1592,10 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
 
     PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME;
     
-    if (full_len > 2 && **name == '*' && isIDFIRST_lazy_if(*name + 1, is_utf8)) {
+    if (   full_len > 2
+        && **name == '*'
+        && isIDFIRST_lazy_if_safe(*name + 1, name_end, is_utf8))
+    {
         /* accidental stringify on a GV? */
         (*name)++;
     }
@@ -1619,8 +1643,8 @@ 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
-                            && strnEQ(*name, "CORE", 4))
-                            hv_name_set(*stash, "CORE", 4, 0);
+                            && strEQs(*name, "CORE"))
+                            hv_name_sets(*stash, "CORE", 0);
                         else
                             hv_name_set(
                                 *stash, nambeg, name_cursor-nambeg, is_utf8
@@ -1639,8 +1663,15 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name,
                 name_cursor++;
             *name = name_cursor+1;
             if (*name == name_end) {
-                if (!*gv)
-                    *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
+                if (!*gv) {
+                   *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE));
+                   if (SvTYPE(*gv) != SVt_PVGV) {
+                       gv_init_pvn(*gv, PL_defstash, "main::", 6,
+                                   GV_ADDMULTI);
+                       GvHV(*gv) =
+                           MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
+                   }
+               }
                 return TRUE;
             }
         }
@@ -1656,7 +1687,7 @@ S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8)
     PERL_ARGS_ASSERT_GV_IS_IN_MAIN;
     
     /* If it's an alphanumeric variable */
-    if ( len && isIDFIRST_lazy_if(name, is_utf8) ) {
+    if ( len && isIDFIRST_lazy_if_safe(name, name + len, is_utf8) ) {
         /* Some "normal" variables are always in main::,
          * like INC or STDOUT.
          */
@@ -1746,14 +1777,14 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len,
                     /* diag_listed_as: Variable "%s" is not imported%s */
                     Perl_ck_warner_d(
                         aTHX_ packWARN(WARN_MISC),
-                        "Variable \"%c%"UTF8f"\" is not imported",
+                        "Variable \"%c%" UTF8f "\" is not imported",
                         sv_type == SVt_PVAV ? '@' :
                         sv_type == SVt_PVHV ? '%' : '$',
                         UTF8fARG(is_utf8, len, name));
                     if (GvCVu(*gvp))
                         Perl_ck_warner_d(
                             aTHX_ packWARN(WARN_MISC),
-                            "\t(Did you mean &%"UTF8f" instead?)\n",
+                            "\t(Did you mean &%" UTF8f " instead?)\n",
                             UTF8fARG(is_utf8, len, name)
                         );
                     *stash = NULL;
@@ -1770,9 +1801,9 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len,
         if (add && !PL_in_clean_all) {
             GV *gv;
             qerror(Perl_mess(aTHX_
-                 "Global symbol \"%s%"UTF8f
+                 "Global symbol \"%s%" UTF8f
                  "\" requires explicit package name (did you forget to "
-                 "declare \"my %s%"UTF8f"\"?)",
+                 "declare \"my %s%" UTF8f "\"?)",
                  (sv_type == SVt_PV ? "$"
                   : sv_type == SVt_PVAV ? "@"
                   : sv_type == SVt_PVHV ? "%"
@@ -1832,25 +1863,31 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
           and VERSION. All the others apply only to the main stash or to
           CORE (which is checked right after this). */
        if (len) {
-           const char * const name2 = name + 1;
            switch (*name) {
            case 'E':
-               if (strnEQ(name2, "XPORT", 5))
+                if (
+                    len >= 6 && name[1] == 'X' &&
+                    (memEQs(name, len, "EXPORT")
+                    ||memEQs(name, len, "EXPORT_OK")
+                    ||memEQs(name, len, "EXPORT_FAIL")
+                    ||memEQs(name, len, "EXPORT_TAGS"))
+                )
                    GvMULTI_on(gv);
                break;
            case 'I':
-               if (strEQ(name2, "SA"))
+                if (memEQs(name, len, "ISA"))
                    gv_magicalize_isa(gv);
                break;
            case 'V':
-               if (strEQ(name2, "ERSION"))
+                if (memEQs(name, len, "VERSION"))
                    GvMULTI_on(gv);
                break;
            case 'a':
-               if (stash == PL_debstash && len==4 && strEQ(name2,"rgs")) {
+                if (stash == PL_debstash && memEQs(name, len, "args")) {
                    GvMULTI_on(gv_AVadd(gv));
                    break;
-               }
+                }
+                /* FALLTHROUGH */
            case 'b':
                if (len == 1 && sv_type == SVt_PV)
                    GvMULTI_on(gv);
@@ -1864,7 +1901,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 (strnEQ(stashname, "CORE", 4))
+         if (strEQs(stashname, "CORE"))
            S_maybe_add_coresub(aTHX_ 0, gv, name, len);
        }
     }
@@ -1885,27 +1922,32 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
        } else
 #endif
        {
-           const char * name2 = name + 1;
            switch (*name) {
            case 'A':
-               if (strEQ(name2, "RGV")) {
+                if (memEQs(name, len, "ARGV")) {
                    IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
                }
-               else if (strEQ(name2, "RGVOUT")) {
+                else if (memEQs(name, len, "ARGVOUT")) {
                    GvMULTI_on(gv);
                }
                break;
            case 'E':
-               if (strnEQ(name2, "XPORT", 5))
+                if (
+                    len >= 6 && name[1] == 'X' &&
+                    (memEQs(name, len, "EXPORT")
+                    ||memEQs(name, len, "EXPORT_OK")
+                    ||memEQs(name, len, "EXPORT_FAIL")
+                    ||memEQs(name, len, "EXPORT_TAGS"))
+                )
                    GvMULTI_on(gv);
                break;
            case 'I':
-               if (strEQ(name2, "SA")) {
+                if (memEQs(name, len, "ISA")) {
                    gv_magicalize_isa(gv);
                }
                break;
            case 'S':
-               if (strEQ(name2, "IG")) {
+                if (memEQs(name, len, "SIG")) {
                    HV *hv;
                    I32 i;
                    if (!PL_psig_name) {
@@ -1936,62 +1978,78 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
                }
                break;
            case 'V':
-               if (strEQ(name2, "ERSION"))
+                if (memEQs(name, len, "VERSION"))
                    GvMULTI_on(gv);
                break;
             case '\003':        /* $^CHILD_ERROR_NATIVE */
-               if (strEQ(name2, "HILD_ERROR_NATIVE"))
+                if (memEQs(name, len, "\003HILD_ERROR_NATIVE"))
                    goto magicalize;
+                                /* @{^CAPTURE} %{^CAPTURE} */
+                if (memEQs(name, len, "\003APTURE")) {
+                    AV* const av = GvAVn(gv);
+                    UV uv= *name;
+
+                    sv_magic(MUTABLE_SV(av), (SV*)uv, 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);
+
+                } 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);
+                }
                break;
            case '\005':        /* $^ENCODING */
-               if (strEQ(name2, "NCODING"))
+                if (memEQs(name, len, "\005NCODING"))
                    goto magicalize;
                break;
            case '\007':        /* $^GLOBAL_PHASE */
-               if (strEQ(name2, "LOBAL_PHASE"))
+                if (memEQs(name, len, "\007LOBAL_PHASE"))
                    goto ro_magicalize;
                break;
            case '\014':        /* $^LAST_FH */
-               if (strEQ(name2, "AST_FH"))
+                if (memEQs(name, len, "\014AST_FH"))
                    goto ro_magicalize;
                break;
             case '\015':        /* $^MATCH */
-                if (strEQ(name2, "ATCH")) {
+                if (memEQs(name, len, "\015ATCH")) {
                     paren = RX_BUFF_IDX_CARET_FULLMATCH;
                     goto storeparen;
                 }
                 break;
            case '\017':        /* $^OPEN */
-               if (strEQ(name2, "PEN"))
+                if (memEQs(name, len, "\017PEN"))
                    goto magicalize;
                break;
            case '\020':        /* $^PREMATCH  $^POSTMATCH */
-                if (strEQ(name2, "REMATCH")) {
+                if (memEQs(name, len, "\020REMATCH")) {
                     paren = RX_BUFF_IDX_CARET_PREMATCH;
                     goto storeparen;
                 }
-               if (strEQ(name2, "OSTMATCH")) {
+                if (memEQs(name, len, "\020OSTMATCH")) {
                     paren = RX_BUFF_IDX_CARET_POSTMATCH;
                     goto storeparen;
                 }
                break;
            case '\024':        /* ${^TAINT} */
-               if (strEQ(name2, "AINT"))
+                if (memEQs(name, len, "\024AINT"))
                    goto ro_magicalize;
                break;
            case '\025':        /* ${^UNICODE}, ${^UTF8LOCALE} */
-               if (strEQ(name2, "NICODE"))
+                if (memEQs(name, len, "\025NICODE"))
                    goto ro_magicalize;
-               if (strEQ(name2, "TF8LOCALE"))
+                if (memEQs(name, len, "\025TF8LOCALE"))
                    goto ro_magicalize;
-               if (strEQ(name2, "TF8CACHE"))
+                if (memEQs(name, len, "\025TF8CACHE"))
                    goto magicalize;
                break;
            case '\027':        /* $^WARNING_BITS */
-               if (strEQ(name2, "ARNING_BITS"))
+                if (memEQs(name, len, "\027ARNING_BITS"))
                    goto magicalize;
 #ifdef WIN32
-               else if (strEQ(name2, "IN32_SLOPPY_STAT"))
+                else if (memEQs(name, len, "\027IN32_SLOPPY_STAT"))
                    goto magicalize;
 #endif
                break;
@@ -2078,35 +2136,38 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
 
            sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len);
 
-            /* magicalization must be done before require_tie_mod is called */
+            /* magicalization must be done before require_tie_mod_s is called */
            if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-               require_tie_mod(gv, "!", "Errno", 5, 1);
+                require_tie_mod_s(gv, '!', "Errno", 1);
 
            break;
-       case '-':               /* $- */
-       case '+':               /* $+ */
-       GvMULTI_on(gv); /* no used once warnings here */
-        {
-            AV* const av = GvAVn(gv);
-           SV* const avc = (*name == '+') ? MUTABLE_SV(av) : NULL;
-
-           sv_magic(MUTABLE_SV(av), avc, PERL_MAGIC_regdata, NULL, 0);
-            sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len);
-            if (avc)
-                SvREADONLY_on(GvSVn(gv));
-            SvREADONLY_on(av);
-
-            if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-                require_tie_mod(gv, name, "Tie::Hash::NamedCapture",23, 0);
+       case '-':               /* $-, %-, @- */
+       case '+':               /* $+, %+, @+ */
+            GvMULTI_on(gv); /* no used once warnings here */
+            {   /* $- $+ */
+                sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len);
+                if (*name == '+')
+                    SvREADONLY_on(GvSVn(gv));
+            }
+            {   /* %- %+ */
+                if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
+                    require_tie_mod_s(gv, *name, "Tie::Hash::NamedCapture",0);
+            }
+            {   /* @- @+ */
+                AV* const av = GvAVn(gv);
+                const UV uv = (UV)*name;
 
+                sv_magic(MUTABLE_SV(av), (SV*)uv, PERL_MAGIC_regdata, NULL, 0);
+                SvREADONLY_on(av);
+            }
             break;
-       }
        case '*':               /* $* */
        case '#':               /* $# */
            if (sv_type == SVt_PV)
-               /* diag_listed_as: $* is no longer supported */
+               /* 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", *name);
+                                "$%c is no longer supported. Its use "
+                                 "will be fatal in Perl 5.30", *name);
            break;
        case '\010':    /* $^H */
            {
@@ -2117,7 +2178,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
        case '[':               /* $[ */
            if ((sv_type == SVt_PV || sv_type == SVt_PVGV)
             && FEATURE_ARYBASE_IS_ENABLED) {
-               require_tie_mod(gv,name,"arybase",7,0);
+                require_tie_mod_s(gv,'[',"arybase",0);
            }
            else goto magicalize;
             break;
@@ -2211,21 +2272,22 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type)
 
     if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) {
         if (*name == '!')
-            require_tie_mod(gv, "!", "Errno", 5, 1);
+            require_tie_mod_s(gv, '!', "Errno", 1);
         else if (*name == '-' || *name == '+')
-            require_tie_mod(gv, name, "Tie::Hash::NamedCapture", 23, 0);
+            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 */
+            /* 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", *name);
+                             "$%c is no longer supported. Its use "
+                             "will be fatal in Perl 5.30", *name);
         }
     }
     if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
       switch (*name) {
       case '[':
-          require_tie_mod(gv,name,"arybase",7,0);
+          require_tie_mod_s(gv,'[',"arybase",0);
           break;
 #ifdef PERL_SAWAMPERSAND
       case '`':
@@ -2316,7 +2378,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                 maybe_multimagic_gv(gv, name, sv_type);
            }
            else if (len == 3 && sv_type == SVt_PVAV
-                 && strnEQ(name, "ISA", 3)
+                 && strEQs(name, "ISA")
                  && (!GvAV(gv) || !SvSMAGICAL(GvAV(gv))))
                gv_magicalize_isa(gv);
        }
@@ -2347,12 +2409,16 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 
     if (add & GV_ADDWARN)
        Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
-               "Had to create %"UTF8f" unexpectedly",
+               "Had to create %" UTF8f " unexpectedly",
                 UTF8fARG(is_utf8, name_end-nambeg, nambeg));
     gv_init_pvn(gv, stash, name, len, (add & GV_ADDMULTI)|is_utf8);
 
-    if ( isIDFIRST_lazy_if(name, is_utf8) && !ckWARN(WARN_ONCE) )
+    if (   full_len != 0
+        && isIDFIRST_lazy_if_safe(name, name + full_len, is_utf8)
+        && !ckWARN(WARN_ONCE) )
+    {
         GvMULTI_on(gv) ;
+    }
 
     /* set up magic where warranted */
     if ( gv_magicalize(gv, stash, name, len, sv_type) ) {
@@ -2443,8 +2509,12 @@ Perl_gv_check(pTHX_ HV *stash)
                 )
                     gv_check(hv);              /* nested package */
            }
-            else if ( *HeKEY(entry) != '_'
-                        && isIDFIRST_lazy_if(HeKEY(entry), HeUTF8(entry)) ) {
+            else if (   HeKLEN(entry) != 0
+                     && *HeKEY(entry) != '_'
+                     && isIDFIRST_lazy_if_safe(HeKEY(entry),
+                                               HeKEY(entry) + HeKLEN(entry),
+                                               HeUTF8(entry)) )
+            {
                 const char *file;
                gv = MUTABLE_GV(HeVAL(entry));
                if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))
@@ -2458,7 +2528,7 @@ Perl_gv_check(pTHX_ HV *stash)
                    = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0);
 #endif
                Perl_warner(aTHX_ packWARN(WARN_ONCE),
-                       "Name \"%"HEKf"::%"HEKf
+                       "Name \"%" HEKf "::%" HEKf
                        "\" used only once: possible typo",
                             HEKfARG(HvNAME_HEK(stash)),
                             HEKfARG(GvNAME_HEK(gv)));
@@ -2474,7 +2544,7 @@ Perl_newGVgen_flags(pTHX_ const char *pack, U32 flags)
     PERL_ARGS_ASSERT_NEWGVGEN_FLAGS;
     assert(!(flags & ~SVf_UTF8));
 
-    return gv_fetchpv(Perl_form(aTHX_ "%"UTF8f"::_GEN_%ld",
+    return gv_fetchpv(Perl_form(aTHX_ "%" UTF8f "::_GEN_%ld",
                                 UTF8fARG(flags, strlen(pack), pack),
                                 (long)PL_gensym++),
                       GV_ADD, SVt_PVGV);
@@ -2554,7 +2624,7 @@ Perl_gp_free(pTHX_ GV *gv)
         const HEK *hvname_hek = HvNAME_HEK(hv);
         if (PL_stashcache && hvname_hek) {
            DEBUG_o(Perl_deb(aTHX_
-                          "gp_free clearing PL_stashcache for '%"HEKf"'\n",
+                          "gp_free clearing PL_stashcache for '%" HEKf "'\n",
                            HEKfARG(hvname_hek)));
            (void)hv_deletehek(PL_stashcache, hvname_hek, G_DISCARD);
         }
@@ -2723,7 +2793,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
                GV *ngv = NULL;
                SV *gvsv = GvSV(gv);
 
-               DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%"SVf256\
+               DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%" SVf256\
                        "\" for overloaded \"%s\" in package \"%.256s\"\n",
                             (void*)GvSV(gv), cp, HvNAME(stash)) );
                if (!gvsv || !SvPOK(gvsv)
@@ -2738,9 +2808,9 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
                                                     ? gvsv
                                                     : newSVpvs_flags("???", SVs_TEMP);
                        /* diag_listed_as: Can't resolve method "%s" overloading "%s" in package "%s" */
-                       Perl_croak(aTHX_ "%s method \"%"SVf256
+                       Perl_croak(aTHX_ "%s method \"%" SVf256
                                    "\" overloading \"%s\" "\
-                                   "in package \"%"HEKf256"\"",
+                                   "in package \"%" HEKf256 "\"",
                                   (GvCVGEN(gv) ? "Stub found while resolving"
                                    : "Can't resolve"),
                                   SVfARG(name), cp,
@@ -3226,7 +3296,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
        SV *msg;
        if (off==-1) off=method;
        msg = sv_2mortal(Perl_newSVpvf(aTHX_
-                     "Operation \"%s\": no method found,%sargument %s%"SVf"%s%"SVf,
+                     "Operation \"%s\": no method found,%sargument %s%" SVf "%s%" SVf,
                      AMG_id2name(method + assignshift),
                      (flags & AMGf_unary ? " " : "\n\tleft "),
                      SvAMAGIC(left)?
@@ -3244,9 +3314,9 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
                        SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(SvSTASH(SvRV(right)))))):
                        SVfARG(&PL_sv_no)));
         if (use_default_op) {
-         DEBUG_o( Perl_deb(aTHX_ "%"SVf, SVfARG(msg)) );
+         DEBUG_o( Perl_deb(aTHX_ "%" SVf, SVfARG(msg)) );
        } else {
-         Perl_croak(aTHX_ "%"SVf, SVfARG(msg));
+         Perl_croak(aTHX_ "%" SVf, SVfARG(msg));
        }
        return NULL;
       }
@@ -3317,7 +3387,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 #ifdef DEBUGGING
   if (!notfound) {
     DEBUG_o(Perl_deb(aTHX_
-                    "Overloaded operator \"%s\"%s%s%s:\n\tmethod%s found%s in package %"SVf"%s\n",
+                    "Overloaded operator \"%s\"%s%s%s:\n\tmethod%s found%s in package %" SVf "%s\n",
                     AMG_id2name(off),
                     method+assignshift==off? "" :
                     " (initially \"",
@@ -3504,7 +3574,7 @@ Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
     PERL_ARGS_ASSERT_GV_NAME_SET;
 
     if (len > I32_MAX)
-       Perl_croak(aTHX_ "panic: gv name too long (%"UVuf")", (UV) len);
+       Perl_croak(aTHX_ "panic: gv name too long (%" UVuf ")", (UV) len);
 
     if (!(flags & GV_ADD) && GvNAME_HEK(gv)) {
        unshare_hek(GvNAME_HEK(gv));