This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
gv.c:require_tie_mod: Accept pvn params
authorFather Chrysostomos <sprout@cpan.org>
Thu, 4 Aug 2016 20:55:41 +0000 (13:55 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 4 Aug 2016 20:59:52 +0000 (13:59 -0700)
All the callers create the SV on the fly.  We might as well put the
SV creation into the function itself.  (A forthcoming commit will
refactor things to avoid the SV when possible.)

embed.fnc
embed.h
gv.c
proto.h

index 61c9296..baa15b2 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1938,7 +1938,8 @@ s  |bool|gv_magicalize|NN GV *gv|NN HV *stash|NN const char *name \
 s  |void|maybe_multimagic_gv|NN GV *gv|NN const char *name|const svtype sv_type
 s  |bool|gv_is_in_main|NN const char *name|STRLEN len \
                       |const U32 is_utf8
-s      |void   |require_tie_mod|NN GV *gv|NN const char *varpv|NN SV* namesv \
+s      |void   |require_tie_mod|NN GV *gv|NN const char *varpv \
+                               |NN const char * name|STRLEN len \
                                |const U32 flags
 #endif
 
diff --git a/embed.h b/embed.h
index 3e43529..930ea91 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define gv_stashsvpvn_cached(a,b,c,d)  S_gv_stashsvpvn_cached(aTHX_ a,b,c,d)
 #define maybe_multimagic_gv(a,b,c)     S_maybe_multimagic_gv(aTHX_ a,b,c)
 #define parse_gv_stash_name(a,b,c,d,e,f,g,h)   S_parse_gv_stash_name(aTHX_ a,b,c,d,e,f,g,h)
-#define require_tie_mod(a,b,c,d)       S_require_tie_mod(aTHX_ a,b,c,d)
+#define require_tie_mod(a,b,c,d,e)     S_require_tie_mod(aTHX_ a,b,c,d,e)
 #  endif
 #  if defined(PERL_IN_HV_C)
 #define clear_placeholders(a,b)        S_clear_placeholders(aTHX_ a,b)
diff --git a/gv.c b/gv.c
index cd1c32d..7fd41f0 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1305,12 +1305,14 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
  * the sv slot must already be magicalized.
  */
 STATIC void
-S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const U32 flags)
+S_require_tie_mod(pTHX_ GV *gv, const char *varpv, const char * name,
+                        STRLEN len, const U32 flags)
 {
     const char varname = *varpv; /* varpv might be clobbered by
                                     load_module, so save it.  For the
                                     moment it’s always a single char.  */
     const SV * const target = varname == '[' ? GvSV(gv) : (SV *)GvHV(gv);
+    SV * const namesv = newSVpvn(name, len);
 
     PERL_ARGS_ASSERT_REQUIRE_TIE_MOD;
 
@@ -2082,7 +2084,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
 
             /* magicalization must be done before require_tie_mod is called */
            if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-               require_tie_mod(gv, "!", newSVpvs("Errno"), 1);
+               require_tie_mod(gv, "!", "Errno", 5, 1);
 
            break;
        case '-':               /* $- */
@@ -2099,7 +2101,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
             SvREADONLY_on(av);
 
             if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-                require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), 0);
+                require_tie_mod(gv, name, "Tie::Hash::NamedCapture",23, 0);
 
             break;
        }
@@ -2119,7 +2121,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
        case '[':               /* $[ */
            if ((sv_type == SVt_PV || sv_type == SVt_PVGV)
             && FEATURE_ARYBASE_IS_ENABLED) {
-               require_tie_mod(gv,name,newSVpvs("arybase"),0);
+               require_tie_mod(gv,name,"arybase",7,0);
            }
            else goto magicalize;
             break;
@@ -2207,9 +2209,9 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type)
 
     if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) {
         if (*name == '!')
-            require_tie_mod(gv, "!", newSVpvs("Errno"), 1);
+            require_tie_mod(gv, "!", "Errno", 5, 1);
         else if (*name == '-' || *name == '+')
-            require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), 0);
+            require_tie_mod(gv, name, "Tie::Hash::NamedCapture", 23, 0);
     } else if (sv_type == SVt_PV) {
         if (*name == '*' || *name == '#') {
             /* diag_listed_as: $* is no longer supported */
@@ -2221,7 +2223,7 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type)
     if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
       switch (*name) {
       case '[':
-          require_tie_mod(gv,name,newSVpvs("arybase"),0);
+          require_tie_mod(gv,name,"arybase",7,0);
           break;
 #ifdef PERL_SAWAMPERSAND
       case '`':
diff --git a/proto.h b/proto.h
index d3918b1..3cdb21c 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4324,9 +4324,9 @@ STATIC void       S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype s
 STATIC bool    S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, STRLEN *len, const char *nambeg, STRLEN full_len, const U32 is_utf8, const I32 add);
 #define PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME   \
        assert(stash); assert(gv); assert(name); assert(len); assert(nambeg)
-STATIC void    S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const U32 flags);
+STATIC void    S_require_tie_mod(pTHX_ GV *gv, const char *varpv, const char * name, STRLEN len, const U32 flags);
 #define PERL_ARGS_ASSERT_REQUIRE_TIE_MOD       \
-       assert(gv); assert(varpv); assert(namesv)
+       assert(gv); assert(varpv); assert(name)
 #endif
 #if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_IN_OP_C)
 PERL_CALLCONV void     Perl_sv_add_backref(pTHX_ SV *const tsv, SV *const sv);