This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Better document setlocale, "use locale" interactions
[perl5.git] / gv.c
diff --git a/gv.c b/gv.c
index 52291d4..8449047 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1026,10 +1026,9 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
                        return gv;
                }
                Perl_croak(aTHX_
-                          "Can't locate object method \"%"SVf
+                          "Can't locate object method \"%"UTF8f
                           "\" via package \"%"HEKf"\"",
-                                   SVfARG(newSVpvn_flags(name, nend - name,
-                                           SVs_TEMP | is_utf8)),
+                                   UTF8fARG(is_utf8, nend - name, name),
                                     HEKfARG(HvNAME_HEK(stash)));
            }
            else {
@@ -1039,14 +1038,14 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
                    packnamesv = newSVpvn_flags(origname, nsplit - origname,
                                                     SVs_TEMP | is_utf8);
                } else {
-                   packnamesv = sv_2mortal(newSVsv(error_report));
+                   packnamesv = error_report;
                }
 
                Perl_croak(aTHX_
-                          "Can't locate object method \"%"SVf"\" via package \"%"SVf"\""
+                          "Can't locate object method \"%"UTF8f
+                          "\" via package \"%"SVf"\""
                           " (perhaps you forgot to load \"%"SVf"\"?)",
-                          SVfARG(newSVpvn_flags(name, nend - name,
-                                SVs_TEMP | is_utf8)),
+                          UTF8fARG(is_utf8, nend - name, name),
                            SVfARG(packnamesv), SVfARG(packnamesv));
            }
        }
@@ -1138,9 +1137,10 @@ 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"::%"SVf"() is deprecated",
+                        "Use of inherited AUTOLOAD for non-method %"SVf
+                        "::%"UTF8f"() is deprecated",
                         SVfARG(packname),
-                         SVfARG(newSVpvn_flags(name, len, SVs_TEMP | is_utf8)));
+                         UTF8fARG(is_utf8, len, name));
 
     if (CvISXSUB(cv)) {
         /* Instead of forcing the XSUB do another lookup for $AUTOLOAD
@@ -1410,7 +1410,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     const char *name = nambeg;
     GV *gv = NULL;
     GV**gvp;
-    I32 len;
+    STRLEN len;
     const char *name_cursor;
     HV *stash = NULL;
     const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT);
@@ -1569,18 +1569,18 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                             (sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp)) ||
                             (sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp)) )
                    {
-                        SV* namesv = newSVpvn_flags(name, len, SVs_TEMP | is_utf8);
                        /* diag_listed_as: Variable "%s" is not imported%s */
                        Perl_ck_warner_d(
                            aTHX_ packWARN(WARN_MISC),
-                           "Variable \"%c%"SVf"\" is not imported",
+                           "Variable \"%c%"UTF8f"\" is not imported",
                            sv_type == SVt_PVAV ? '@' :
                            sv_type == SVt_PVHV ? '%' : '$',
-                           SVfARG(namesv));
+                           UTF8fARG(is_utf8, len, name));
                        if (GvCVu(*gvp))
                            Perl_ck_warner_d(
                                aTHX_ packWARN(WARN_MISC),
-                               "\t(Did you mean &%"SVf" instead?)\n", SVfARG(namesv)
+                               "\t(Did you mean &%"UTF8f" instead?)\n",
+                               UTF8fARG(is_utf8, len, name)
                            );
                        stash = NULL;
                    }
@@ -1597,15 +1597,14 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 
     if (!stash) {
        if (add && !PL_in_clean_all) {
-           SV * const namesv = newSVpvn_flags(name, len, is_utf8);
            SV * const err = Perl_mess(aTHX_
-                "Global symbol \"%s%"SVf"\" requires explicit package name",
+                "Global symbol \"%s%"UTF8f
+                "\" requires explicit package name",
                 (sv_type == SVt_PV ? "$"
                  : sv_type == SVt_PVAV ? "@"
                  : sv_type == SVt_PVHV ? "%"
-                 : ""), SVfARG(namesv));
+                 : ""), UTF8fARG(is_utf8, len, name));
            GV *gv;
-           SvREFCNT_dec_NN(namesv);
            if (is_utf8)
                SvUTF8_on(err);
            qerror(err);
@@ -1646,23 +1645,13 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                    require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
                else if (*name == '-' || *name == '+')
                    require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
-              } else if (sv_type == SVt_PV && *name == '#') {
-                  Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED,
-                                                   WARN_SYNTAX),
-                                   "$# is no longer supported");
-              }
-              if (*name == '*') {
-                  if (sv_type == SVt_PV)
+              } else if (sv_type == SVt_PV) {
+                  if (*name == '*' || *name == '#') {
+                      /* diag_listed_as: $* is no longer supported */
                       Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED,
                                                        WARN_SYNTAX),
-                                       "$* is no longer supported, and will become a syntax error");
-                  else
-                      Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                                       "%c* is deprecated, and will become a syntax error",
-                                       sv_type == SVt_PVAV ? '@'
-                                       : sv_type == SVt_PVCV ? '&'
-                                       : sv_type == SVt_PVHV ? '%'
-                                       : '*');
+                                       "$%c is no longer supported", *name);
+                  }
               }
              if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
                 switch (*name) {
@@ -1710,8 +1699,9 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     faking_it = SvOK(gv);
 
     if (add & GV_ADDWARN)
-       Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "Had to create %"SVf" unexpectedly",
-                SVfARG(newSVpvn_flags(nambeg, name_end-nambeg, SVs_TEMP | is_utf8 )));
+       Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+               "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)
@@ -1952,22 +1942,11 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
             break;
        }
        case '*':               /* $* */
-           if (sv_type == SVt_PV)
-               Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                                "$* is no longer supported, and will become a syntax error");
-            else {
-               Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                                 "%c* is deprecated, and will become a syntax error",
-                                 sv_type == SVt_PVAV ? '@'
-                                 : sv_type == SVt_PVCV ? '&'
-                                 : sv_type == SVt_PVHV ? '%'
-                                 : '*');
-            }
-           break;
        case '#':               /* $# */
            if (sv_type == SVt_PV)
+               /* diag_listed_as: $* is no longer supported */
                Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
-                                "$# is no longer supported");
+                                "$%c is no longer supported", *name);
            break;
        case '\010':    /* $^H */
            {
@@ -2145,10 +2124,10 @@ Perl_newGVgen_flags(pTHX_ const char *pack, U32 flags)
 {
     dVAR;
     PERL_ARGS_ASSERT_NEWGVGEN_FLAGS;
+    assert(!(flags & ~SVf_UTF8));
 
-    return gv_fetchpv(Perl_form(aTHX_ "%"SVf"::_GEN_%ld",
-                                    SVfARG(newSVpvn_flags(pack, strlen(pack),
-                                            SVs_TEMP | flags)),
+    return gv_fetchpv(Perl_form(aTHX_ "%"UTF8f"::_GEN_%ld",
+                                UTF8fARG(flags, strlen(pack), pack),
                                 (long)PL_gensym++),
                       GV_ADD, SVt_PVGV);
 }
@@ -3195,10 +3174,11 @@ Perl_gv_try_downgrade(pTHX_ GV *gv)
                        HEK_LEN(namehek)*(HEK_UTF8(namehek) ? -1 : 1), 0)) &&
            *gvp == (SV*)gv) {
        SV *value = SvREFCNT_inc(CvXSUBANY(cv).any_ptr);
+       const bool imported = !!GvIMPORTED_CV(gv);
        SvREFCNT(gv) = 0;
        sv_clear((SV*)gv);
        SvREFCNT(gv) = 1;
-       SvFLAGS(gv) = SVt_IV|SVf_ROK;
+       SvFLAGS(gv) = SVt_IV|SVf_ROK|SVprv_PCS_IMPORTED * imported;
        SvANY(gv) = (XPVGV*)((char*)&(gv->sv_u.svu_iv) -
                                STRUCT_OFFSET(XPVIV, xiv_iv));
        SvRV_set(gv, value);
Unnamed repository; edit this file 'description' to name the repository.