Enter gv_fetchsv_nomg

There are so many cases that use this incantation to get around
gv_fetchsv’s calling of get-magic--

    STRLEN len;
    const char *name = SvPV_nomg_const(sv,len);
    gv = gv_fetchpvn_flags(name, len, flags | SvUTF8(sv), type);

--that it’s about time we had a shorthand.

diff --git a/gv.c b/gv.c
index 3427944..c274065 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1004,7 +1004,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, const svtype sv_type) {
 GV *
 Perl_gv_fetchsv(pTHX_ SV *name, I32 flags, const svtype sv_type) {
     STRLEN len;
-    const char * const nambeg = SvPV_const(name, len);
+    const char * const nambeg =
+       SvPV_flags_const(name, len, flags & GV_NO_SVGMAGIC ? 0 : SV_GMAGIC);
     PERL_ARGS_ASSERT_GV_FETCHSV;
     return gv_fetchpvn_flags(nambeg, len, flags | SvUTF8(name), sv_type);
 }

diff --git a/gv.h b/gv.h
index b9d04e6..6ef1c2b 100644 (file)
--- a/gv.h
+++ b/gv.h
@@ -214,13 +214,15 @@ Return the SV from the GV.
 #define GV_AUTOLOAD    0x100   /* gv_fetchmethod_flags() should AUTOLOAD  */
 #define GV_CROAK       0x200   /* gv_fetchmethod_flags() should croak  */
 #define GV_ADDMG       0x400   /* add if magical */
+#define GV_NO_SVGMAGIC 0x800   /* Skip get-magic on an SV argument;
+                                  used only by gv_fetchsv(_nomg) */
 
 /*      SVf_UTF8 (more accurately the return value from SvUTF8) is also valid
        as a flag to gv_fetch_pvn_flags, so ensure it lies outside this range.
 */
 
 #define GV_NOADD_MASK \
-    (SVf_UTF8|GV_NOADD_NOINIT|GV_NOEXPAND|GV_NOTQUAL|GV_ADDMG)
+  (SVf_UTF8|GV_NOADD_NOINIT|GV_NOEXPAND|GV_NOTQUAL|GV_ADDMG|GV_NO_SVGMAGIC)
 /* The bit flags that don't cause gv_fetchpv() to add a symbol if not
    found (with the exception GV_ADDMG, which *might* cause the symbol
    to be added) */
@@ -228,6 +230,7 @@ Return the SV from the GV.
 #define gv_fullname3(sv,gv,prefix) gv_fullname4(sv,gv,prefix,TRUE)
 #define gv_efullname3(sv,gv,prefix) gv_efullname4(sv,gv,prefix,TRUE)
 #define gv_fetchmethod(stash, name) gv_fetchmethod_autoload(stash, name, TRUE)
+#define gv_fetchsv_nomg(n,f,t) gv_fetchsv(n,(f)|GV_NO_SVGMAGIC,t)
 
 #define gv_AVadd(gv) gv_add_by_type((gv), SVt_PVAV)
 #define gv_HVadd(gv) gv_add_by_type((gv), SVt_PVHV)

diff --git a/pp.c b/pp.c
index ba337b2..069e394 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -208,10 +208,8 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict,
            }
            if (noinit)
            {
-               STRLEN len;
-               const char * const nambeg = SvPV_nomg_const(sv, len);
-               if (!(sv = MUTABLE_SV(gv_fetchpvn_flags(
-                          nambeg, len, SvUTF8(sv)|GV_ADDMG, SVt_PVGV
+               if (!(sv = MUTABLE_SV(gv_fetchsv_nomg(
+                          sv, GV_ADDMG, SVt_PVGV
                   ))))
                    return &PL_sv_undef;
            }
@@ -231,15 +229,7 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict,
                       things.  */
                    return sv;
                }
-               {
-                   STRLEN len;
-                   const char * const nambeg = SvPV_nomg_const(sv, len);
-                   sv = MUTABLE_SV(
-                       gv_fetchpvn_flags(
-                           nambeg, len, GV_ADD | SvUTF8(sv), SVt_PVGV
-                       )
-                   );
-               }
+               sv = MUTABLE_SV(gv_fetchsv_nomg(sv, GV_ADD, SVt_PVGV));
            }
            /* FAKE globs in the symbol table cause weird bugs (#77810) */
            SvFAKE_off(sv);
@@ -305,20 +295,14 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
     if ((PL_op->op_flags & OPf_SPECIAL) &&
        !(PL_op->op_flags & OPf_MOD))
        {
-           STRLEN len;
-           const char * const nambeg = SvPV_nomg_const(sv, len);
-           if (!(gv = gv_fetchpvn_flags(
-                          nambeg, len, SvUTF8(sv)|GV_ADDMG, type
-              )))
+           if (!(gv = gv_fetchsv_nomg(sv, GV_ADDMG, type)))
                {
                    **spp = &PL_sv_undef;
                    return NULL;
                }
        }
     else {
-       STRLEN len;
-       const char * const nambeg = SvPV_nomg_const(sv, len);
-       gv = gv_fetchpvn_flags(nambeg, len, GV_ADD | SvUTF8(sv), type);
+       gv = gv_fetchsv_nomg(sv, GV_ADD, type);
     }
     return gv;
 }

diff --git a/pp_hot.c b/pp_hot.c
index 6a22452..573f496 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -125,8 +125,6 @@ PP(pp_sassign)
        const U32 cv_type = SvTYPE(cv);
        const bool is_gv = isGV_with_GP(right);
        const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
-       STRLEN len = 0;
-       const char *nambeg = is_gv ? NULL : SvPV_nomg_const(right, len);
 
        if (!got_coderef) {
            assert(SvROK(cv));
@@ -137,9 +135,7 @@ PP(pp_sassign)
           context. */
        if (!got_coderef && !is_gv && GIMME_V == G_VOID) {
            /* Is the target symbol table currently empty?  */
-           GV * const gv = gv_fetchpvn_flags(
-               nambeg, len, SvUTF8(right)|GV_NOINIT, SVt_PVGV
-           );
+           GV * const gv = gv_fetchsv_nomg(right, GV_NOINIT, SVt_PVGV);
            if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
                /* Good. Create a new proxy constant subroutine in the target.
                   The gv becomes a(nother) reference to the constant.  */
@@ -157,9 +153,7 @@ PP(pp_sassign)
        /* Need to fix things up.  */
        if (!is_gv) {
            /* Need to fix GV.  */
-           right = MUTABLE_SV(gv_fetchpvn_flags(
-               nambeg, len, SvUTF8(right)|GV_ADD, SVt_PVGV
-           ));
+           right = MUTABLE_SV(gv_fetchsv_nomg(right,GV_ADD, SVt_PVGV));
        }
 
        if (!got_coderef) {

diff --git a/sv.c b/sv.c
index bb9dbd3..912bfd6 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4161,11 +4161,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
                           "Undefined value assigned to typeglob");
        }
        else {
-           STRLEN len;
-           const char *nambeg = SvPV_nomg_const(sstr, len);
-           GV *gv = gv_fetchpvn_flags(
-               nambeg, len, SvUTF8(sstr)|GV_ADD, SVt_PVGV
-           );
+           GV *gv = gv_fetchsv_nomg(sstr, GV_ADD, SVt_PVGV);
            if (dstr != (const SV *)gv) {
                const char * const name = GvNAME((const GV *)dstr);
                const STRLEN len = GvNAMELEN(dstr);
@@ -8874,11 +8870,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **const st, GV **const gvp, const I32 lref)
            gv = MUTABLE_GV(sv);
        }
        else {
-           STRLEN len;
-           const char * const nambeg = SvPV_nomg_const(sv, len);
-           gv = gv_fetchpvn_flags(
-               nambeg, len, lref | SvUTF8(sv), SVt_PVCV
-           );
+           gv = gv_fetchsv_nomg(sv, lref, SVt_PVCV);
        }
        *gvp = gv;
        if (!gv) {