pad.c: comment typo

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index 5af8827..5da09df 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -385,6 +385,7 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag
        case SVt_PVIO:
             Perl_croak(aTHX_ "Cannot convert a reference to %s to typeglob",
                       sv_reftype(has_constant, 0));
+            NOT_REACHED; /* NOTREACHED */
             break;
 
        default: NOOP;
@@ -421,7 +422,7 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag
        /* Not actually a constant.  Just a regular sub.  */
        CV * const cv = (CV *)has_constant;
        GvCV_set(gv,cv);
-       if (CvSTASH(cv) == stash && (
+       if (CvNAMED(cv) && CvSTASH(cv) == stash && (
               CvNAME_HEK(cv) == GvNAME_HEK(gv)
            || (  HEK_LEN(CvNAME_HEK(cv)) == HEK_LEN(GvNAME_HEK(gv))
               && HEK_FLAGS(CvNAME_HEK(cv)) != HEK_FLAGS(GvNAME_HEK(gv))
@@ -736,7 +737,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
 
     /* check locally for a real method or a cache entry */
     he = (HE*)hv_common(
-        cachestash, meth, name, len, (flags & SVf_UTF8) ? HVhek_UTF8 : 0, create, NULL, 0
+        cachestash, meth, name, len, is_utf8 ? HVhek_UTF8 : 0, create, NULL, 0
     );
     if (he) gvp = (GV**)&HeVAL(he);
     else gvp = NULL;
@@ -1209,15 +1210,14 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
        return NULL;
 
     /*
-     * Inheriting AUTOLOAD for non-methods works ... for now.
+     * Inheriting AUTOLOAD for non-methods no longer works
      */
     if (
         !(flags & GV_AUTOLOAD_ISMETHOD)
      && (GvCVGEN(gv) || GvSTASH(gv) != stash)
     )
-       Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                        "Use of inherited AUTOLOAD for non-method %" SVf
-                        "::%" UTF8f "() is deprecated",
+        Perl_croak(aTHX_ "Use of inherited AUTOLOAD for non-method %" SVf
+                         "::%" UTF8f "() is no longer allowed",
                         SVfARG(packname),
                          UTF8fARG(is_utf8, len, name));
 
@@ -1337,6 +1337,7 @@ S_require_tie_mod(pTHX_ GV *gv, const char varname, const char * name,
       GV **gvp;
       dSP;
 
+      PUSHSTACKi(PERLSI_MAGIC);
       ENTER;
 
 #define HV_FETCH_TIE_FUNC (GV **)hv_fetchs(stash, "_tie_it", 0)
@@ -1366,6 +1367,7 @@ S_require_tie_mod(pTHX_ GV *gv, const char varname, const char * name,
       PUTBACK;
       call_sv((SV *)*gvp, G_VOID|G_DISCARD);
       LEAVE;
+      POPSTACK;
     }
 }
 
@@ -1495,7 +1497,14 @@ S_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 flag
         (flags & SVf_UTF8) ? HVhek_UTF8 : 0, 0, NULL, 0
     );
 
-    if (he) return INT2PTR(HV*,SvIVX(HeVAL(he)));
+    if (he) {
+        SV *sv = HeVAL(he);
+        HV *hv;
+        assert(SvIOK(sv));
+        hv = INT2PTR(HV*, SvIVX(sv));
+        assert(SvTYPE(hv) == SVt_PVHV);
+        return hv;
+    }
     else if (flags & GV_CACHE_ONLY) return NULL;
 
     if (namesv) {
@@ -1662,8 +1671,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;
             }
         }
@@ -1979,9 +1995,9 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
                                 /* @{^CAPTURE} %{^CAPTURE} */
                 if (memEQs(name, len, "\003APTURE")) {
                     AV* const av = GvAVn(gv);
-                    UV uv= *name;
+                    const Size_t n = *name;
 
-                    sv_magic(MUTABLE_SV(av), (SV*)uv, PERL_MAGIC_regdata, NULL, 0);
+                    sv_magic(MUTABLE_SV(av), (SV*)n, PERL_MAGIC_regdata, NULL, 0);
                     SvREADONLY_on(av);
 
                     if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
@@ -2147,12 +2163,20 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
             }
             {   /* @- @+ */
                 AV* const av = GvAVn(gv);
-                const UV uv = (UV)*name;
+                const Size_t n = *name;
 
-                sv_magic(MUTABLE_SV(av), (SV*)uv, PERL_MAGIC_regdata, NULL, 0);
+                sv_magic(MUTABLE_SV(av), (SV*)n, PERL_MAGIC_regdata, NULL, 0);
                 SvREADONLY_on(av);
             }
             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;
        case '\010':    /* $^H */
            {
                HV *const hv = GvHVn(gv);
@@ -2259,6 +2283,14 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type)
             require_tie_mod_s(gv, '!', "Errno", 1);
         else if (*name == '-' || *name == '+')
             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);
+        }
     }
     if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
       switch (*name) {