diff options
| -rw-r--r-- | embed.fnc | 4 | ||||
| -rw-r--r-- | embed.h | 4 | ||||
| -rw-r--r-- | gv.c | 18 | ||||
| -rw-r--r-- | gv.h | 1 | ||||
| -rw-r--r-- | proto.h | 6 |
5 files changed, 18 insertions, 15 deletions
@@ -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 @@ -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) @@ -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 */ @@ -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) @@ -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) |