gv.c: newGVgen_flags and a flags parameter for gv_get_super_pkg.

diff --git a/embed.fnc b/embed.fnc
index 23d071d..6e16b54 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -873,7 +873,7 @@ Apa |OP*    |newAVREF       |NN OP* o
 Apda   |OP*    |newBINOP       |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last
 Apa    |OP*    |newCVREF       |I32 flags|NULLOK OP* o
 Apda   |OP*    |newGVOP        |I32 type|I32 flags|NN GV* gv
-Apa    |GV*    |newGVgen       |NN const char* pack
+Apa    |GV*    |newGVgen_flags |NN const char* pack|U32 flags
 Apa    |OP*    |newGVREF       |I32 type|NULLOK OP* o
 ApaR   |OP*    |newHVREF       |NN OP* o
 AmdbR  |HV*    |newHV
@@ -1617,7 +1617,7 @@ sR        |I32    |do_trans_complex_utf8  |NN SV * const sv
 s      |void   |gv_init_svtype |NN GV *gv|const svtype sv_type
 s      |void   |gv_magicalize_isa      |NN GV *gv
 s      |void   |gv_magicalize_overload |NN GV *gv
-s      |HV*    |gv_get_super_pkg|NN const char* name|I32 namelen
+s      |HV*    |gv_get_super_pkg|NN const char* name|I32 namelen|U32 flags
 s      |HV*    |require_tie_mod|NN GV *gv|NN const char *varpv|NN SV* namesv \
                                |NN const char *methpv|const U32 flags
 #endif

diff --git a/embed.h b/embed.h
index 8430619..92999c4 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -331,7 +331,7 @@
 #define newGIVENOP(a,b,c)      Perl_newGIVENOP(aTHX_ a,b,c)
 #define newGVOP(a,b,c)         Perl_newGVOP(aTHX_ a,b,c)
 #define newGVREF(a,b)          Perl_newGVREF(aTHX_ a,b)
-#define newGVgen(a)            Perl_newGVgen(aTHX_ a)
+#define newGVgen_flags(a,b)    Perl_newGVgen_flags(aTHX_ a,b)
 #define newHVREF(a)            Perl_newHVREF(aTHX_ a)
 #define newHVhv(a)             Perl_newHVhv(aTHX_ a)
 #define newLISTOP(a,b,c,d)     Perl_newLISTOP(aTHX_ a,b,c,d)
@@ -1301,7 +1301,7 @@
 #define sequence_tail(a)       S_sequence_tail(aTHX_ a)
 #  endif
 #  if defined(PERL_IN_GV_C)
-#define gv_get_super_pkg(a,b)  S_gv_get_super_pkg(aTHX_ a,b)
+#define gv_get_super_pkg(a,b,c)        S_gv_get_super_pkg(aTHX_ a,b,c)
 #define gv_init_svtype(a,b)    S_gv_init_svtype(aTHX_ a,b)
 #define gv_magicalize_isa(a)   S_gv_magicalize_isa(aTHX_ a)
 #define gv_magicalize_overload(a)      S_gv_magicalize_overload(aTHX_ a)

diff --git a/gv.c b/gv.c
index e363a4c..fa5ed65 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -891,7 +891,7 @@ C<call_sv> apply equally to these functions.
 */
 
 STATIC HV*
-S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen)
+S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen, U32 flags)
 {
     AV* superisa;
     GV** gvp;
@@ -991,7 +991,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
            SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER",
                                                  CopSTASHPV(PL_curcop)));
            /* __PACKAGE__::SUPER stash should be autovivified */
-           stash = gv_get_super_pkg(SvPVX_const(tmpstr), SvCUR(tmpstr));
+           stash = gv_get_super_pkg(SvPVX_const(tmpstr), SvCUR(tmpstr), SvUTF8(tmpstr));
            DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
                         origname, HvNAME_get(stash), name) );
        }
@@ -1004,7 +1004,7 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
            if (!stash && (nsplit - origname) >= 7 &&
                strnEQ(nsplit - 7, "::SUPER", 7) &&
                gv_stashpvn(origname, nsplit - origname - 7, 0))
-             stash = gv_get_super_pkg(origname, nsplit - origname);
+             stash = gv_get_super_pkg(origname, nsplit - origname, flags);
        }
        ostash = stash;
     }
@@ -2028,14 +2028,16 @@ Perl_gv_check(pTHX_ const HV *stash)
 }
 
 GV *
-Perl_newGVgen(pTHX_ const char *pack)
+Perl_newGVgen_flags(pTHX_ const char *pack, U32 flags)
 {
     dVAR;
+    PERL_ARGS_ASSERT_NEWGVGEN_FLAGS;
 
-    PERL_ARGS_ASSERT_NEWGVGEN;
-
-    return gv_fetchpv(Perl_form(aTHX_ "%s::_GEN_%ld", pack, (long)PL_gensym++),
-                     GV_ADD, SVt_PVGV);
+    return gv_fetchpv(Perl_form(aTHX_ "%"SVf"::_GEN_%ld",
+                                    SVfARG(newSVpvn_flags(pack, strlen(pack),
+                                            SVs_TEMP | flags)),
+                                (long)PL_gensym++),
+                      GV_ADD, SVt_PVGV);
 }
 
 /* hopefully this is only called on local symbol table entries */

diff --git a/gv.h b/gv.h
index 2b6941a..3140de4 100644 (file)
--- a/gv.h
+++ b/gv.h
@@ -246,6 +246,7 @@ Return the SV from the GV.
 #define gv_fetchmethod_flags(stash,name,flags) gv_fetchmethod_pv_flags(stash, name, flags)
 #define gv_autoload4(stash, name, len, method) \
        gv_autoload_pvn(stash, name, len, !!(method))
+#define newGVgen(pack)  newGVgen_flags(pack, 0)
 
 #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/proto.h b/proto.h
index 2262cb3..048b782 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2563,11 +2563,11 @@ PERL_CALLCONV OP*       Perl_newGVREF(pTHX_ I32 type, OP* o)
                        __attribute__malloc__
                        __attribute__warn_unused_result__;
 
-PERL_CALLCONV GV*      Perl_newGVgen(pTHX_ const char* pack)
+PERL_CALLCONV GV*      Perl_newGVgen_flags(pTHX_ const char* pack, U32 flags)
                        __attribute__malloc__
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_NEWGVGEN      \
+#define PERL_ARGS_ASSERT_NEWGVGEN_FLAGS        \
        assert(pack)
 
 /* PERL_CALLCONV HV*   Perl_newHV(pTHX)
@@ -5367,7 +5367,7 @@ PERL_CALLCONV void        Perl_hv_kill_backrefs(pTHX_ HV *hv)
 
 #endif
 #if defined(PERL_IN_GV_C)
-STATIC HV*     S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen)
+STATIC HV*     S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen, U32 flags)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_GV_GET_SUPER_PKG      \
        assert(name)