This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Merge multi and flags params to gv_init_*
authorFather Chrysostomos <sprout@cpan.org>
Sun, 2 Oct 2011 20:57:19 +0000 (13:57 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 6 Oct 2011 20:01:02 +0000 (13:01 -0700)
Since multi is a boolean (even though it’s typed as an int), there is
no need to have a separate parameter.  We can just use a flag bit.

embed.fnc
embed.h
ext/XS-APItest/APItest.xs
gv.c
gv.h
proto.h

index a4b495f..cd484d3 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -476,11 +476,11 @@ pX        |void   |cvgv_set       |NN CV* cv|NULLOK GV* gv
 pX     |void   |cvstash_set    |NN CV* cv|NULLOK HV* stash
 Amd    |void   |gv_init        |NN GV* gv|NULLOK HV* stash \
                                 |NN const char* name|STRLEN len|int multi
-Ap     |void   |gv_init_sv     |NN GV* gv|NULLOK HV* stash|NN SV* namesv|int multi|U32 flags
+Ap     |void   |gv_init_sv     |NN GV* gv|NULLOK HV* stash|NN SV* namesv|U32 flags
 Ap     |void   |gv_init_pv     |NN GV* gv|NULLOK HV* stash|NN const char* name \
-                                |int multi|U32 flags
+                                |U32 flags
 Ap     |void   |gv_init_pvn    |NN GV* gv|NULLOK HV* stash|NN const char* name \
-                                |STRLEN len|int multi|U32 flags
+                                |STRLEN len|U32 flags
 Ap     |void   |gv_name_set    |NN GV* gv|NN const char *name|U32 len|U32 flags
 XMpd   |void   |gv_try_downgrade|NN GV* gv
 Apd    |HV*    |gv_stashpv     |NN const char* name|I32 flags
diff --git a/embed.h b/embed.h
index 92999c4..72d464d 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define gv_fullname(a,b)       Perl_gv_fullname(aTHX_ a,b)
 #define gv_fullname4(a,b,c,d)  Perl_gv_fullname4(aTHX_ a,b,c,d)
 #define gv_handler(a,b)                Perl_gv_handler(aTHX_ a,b)
-#define gv_init_pv(a,b,c,d,e)  Perl_gv_init_pv(aTHX_ a,b,c,d,e)
-#define gv_init_pvn(a,b,c,d,e,f)       Perl_gv_init_pvn(aTHX_ a,b,c,d,e,f)
-#define gv_init_sv(a,b,c,d,e)  Perl_gv_init_sv(aTHX_ a,b,c,d,e)
+#define gv_init_pv(a,b,c,d)    Perl_gv_init_pv(aTHX_ a,b,c,d)
+#define gv_init_pvn(a,b,c,d,e) Perl_gv_init_pvn(aTHX_ a,b,c,d,e)
+#define gv_init_sv(a,b,c,d)    Perl_gv_init_sv(aTHX_ a,b,c,d)
 #define gv_name_set(a,b,c,d)   Perl_gv_name_set(aTHX_ a,b,c,d)
 #define gv_stashpv(a,b)                Perl_gv_stashpv(aTHX_ a,b)
 #define gv_stashpvn(a,b,c)     Perl_gv_stashpvn(aTHX_ a,b,c)
index 6ef52d1..1af3674 100644 (file)
@@ -1852,18 +1852,19 @@ gv_init_type(namesv, multi, flags, type)
     PPCODE:
         if (SvTYPE(gv) == SVt_PVGV)
             Perl_croak(aTHX_ "GV is already a PVGV");
+        if (multi) flags |= GV_ADDMULTI;
         switch (type) {
            case 0:
               gv_init(gv, PL_defstash, name, len, multi);
                break;
            case 1:
-               gv_init_sv(gv, PL_defstash, namesv, multi, flags);
+               gv_init_sv(gv, PL_defstash, namesv, flags);
                break;
            case 2:
-               gv_init_pv(gv, PL_defstash, name, multi, flags | SvUTF8(namesv));
+               gv_init_pv(gv, PL_defstash, name, flags | SvUTF8(namesv));
                break;
            case 3:
-               gv_init_pvn(gv, PL_defstash, name, len, multi, flags | SvUTF8(namesv));
+               gv_init_pvn(gv, PL_defstash, name, len, flags | SvUTF8(namesv));
                break;
         }
        XPUSHs( gv ? (SV*)gv : &PL_sv_undef);
diff --git a/gv.c b/gv.c
index f5dedee..1963e08 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -261,19 +261,22 @@ C<gv> is the scalar to be converted.
 
 C<stash> is the parent stash/package, if any.
 
-C<name> and C<len> give the name.  C<flags> can be set to SVf_UTF8 for a
-UTF8 string, or the return value of SvUTF8(sv).  The name must be unqualified; that is, it must not include the package name.  If C<gv> is a
+C<name> and C<len> give the name.  The name must be unqualified;
+that is, it must not include the package name.  If C<gv> is a
 stash element, it is the caller's responsibility to ensure that the name
 passed to this function matches the name of the element.  If it does not
 match, perl's internal bookkeeping will get out of sync.
 
-C<multi>, when set to a true value, means to pretend that the GV has been
+C<flags> can be set to SVf_UTF8 if C<name> is a UTF8 string, or
+the return value of SvUTF8(sv).  It can also take the
+GV_ADDMULTI flag, which means to pretend that the GV has been
 seen before (i.e., suppress "Used once" warnings).
 
 =for apidoc gv_init
 
 The old form of gv_init_pvn().  It does not work with UTF8 strings, as it
-has no flags parameter.
+has no flags parameter.  If the C<multi> parameter is set, the
+GV_ADDMULTI flag will be passed to gv_init_pvn().
 
 =for apidoc gv_init_pv
 
@@ -289,7 +292,7 @@ char * and length parameters.  C<flags> is currently unused.
 */
 
 void
-Perl_gv_init_sv(pTHX_ GV *gv, HV *stash, SV* namesv, int multi, U32 flags)
+Perl_gv_init_sv(pTHX_ GV *gv, HV *stash, SV* namesv, U32 flags)
 {
    char *namepv;
    STRLEN namelen;
@@ -297,18 +300,18 @@ Perl_gv_init_sv(pTHX_ GV *gv, HV *stash, SV* namesv, int multi, U32 flags)
    namepv = SvPV(namesv, namelen);
    if (SvUTF8(namesv))
        flags |= SVf_UTF8;
-   gv_init_pvn(gv, stash, namepv, namelen, multi, flags);
+   gv_init_pvn(gv, stash, namepv, namelen, flags);
 }
 
 void
-Perl_gv_init_pv(pTHX_ GV *gv, HV *stash, const char *name, int multi, U32 flags)
+Perl_gv_init_pv(pTHX_ GV *gv, HV *stash, const char *name, U32 flags)
 {
    PERL_ARGS_ASSERT_GV_INIT_PV;
-   gv_init_pvn(gv, stash, name, strlen(name), multi, flags);
+   gv_init_pvn(gv, stash, name, strlen(name), flags);
 }
 
 void
-Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi, U32 flags)
+Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flags)
 {
     dVAR;
     const U32 old_type = SvTYPE(gv);
@@ -359,8 +362,8 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int mult
     if (stash)
        Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(gv));
     gv_name_set(gv, name, len, GV_ADD | ( flags & SVf_UTF8 ? SVf_UTF8 : 0 ));
-    if (multi || doproto)              /* doproto means it _was_ mentioned */
-       GvMULTI_on(gv);
+    if (flags & GV_ADDMULTI || doproto)        /* doproto means it */
+       GvMULTI_on(gv);                 /* _was_ mentioned */
     if (doproto) {                     /* Replicate part of newSUB here. */
        CV *cv;
        ENTER;
@@ -668,7 +671,7 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level,
       have_gv:
         assert(topgv);
         if (SvTYPE(topgv) != SVt_PVGV)
-            gv_init_pvn(topgv, stash, name, len, TRUE, is_utf8);
+            gv_init_pvn(topgv, stash, name, len, GV_ADDMULTI|is_utf8);
         if ((cand_cv = GvCV(topgv))) {
             /* If genuine method or valid cache entry, use it */
             if (!GvCVGEN(topgv) || GvCVGEN(topgv) == topgen_cmp) {
@@ -734,7 +737,7 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level,
        have_candidate:
         assert(candidate);
         if (SvTYPE(candidate) != SVt_PVGV)
-            gv_init_pvn(candidate, cstash, name, len, TRUE, is_utf8);
+            gv_init_pvn(candidate, cstash, name, len, GV_ADDMULTI|is_utf8);
         if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
             /*
              * Found real method, cache method in topgv if:
@@ -911,7 +914,7 @@ S_gv_get_super_pkg(pTHX_ const char* name, I32 namelen, U32 flags)
     stash = gv_stashpvn(name, namelen, GV_ADD);
     gvp = (GV**)hv_fetchs(stash, "ISA", TRUE);
     gv = *gvp;
-    gv_init_pvn(gv, stash, "ISA", 3, TRUE, flags & SVf_UTF8);
+    gv_init_pvn(gv, stash, "ISA", 3, GV_ADDMULTI|(flags & SVf_UTF8));
     superisa = GvAVn(gv);
     GvMULTI_on(gv);
     sv_magic(MUTABLE_SV(superisa), MUTABLE_SV(gv), PERL_MAGIC_isa, NULL, 0);
@@ -1166,7 +1169,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
     ENTER;
 
     if (!isGV(vargv)) {
-       gv_init_pvn(vargv, varstash, S_autoload, S_autolen, FALSE, 0);
+       gv_init_pvn(vargv, varstash, S_autoload, S_autolen, 0);
 #ifdef PERL_DONT_CREATE_GVSV
        GvSV(vargv) = newSV(0);
 #endif
@@ -1418,7 +1421,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                gv = gvp ? *gvp : NULL;
                if (gv && gv != (const GV *)&PL_sv_undef) {
                    if (SvTYPE(gv) != SVt_PVGV)
-                       gv_init_pvn(gv, stash, key, len, (add & GV_ADDMULTI)is_utf8);
+                       gv_init_pvn(gv, stash, key, len, (add & GV_ADDMULTI)|is_utf8);
                    else
                        GvMULTI_on(gv);
                }
@@ -1619,7 +1622,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 
     if (add & GV_ADDWARN)
        Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "Had to create %s unexpectedly", nambeg);
-    gv_init_pvn(gv, stash, name, len, add & GV_ADDMULTI, is_utf8);
+    gv_init_pvn(gv, stash, name, len, (add & GV_ADDMULTI)|is_utf8);
 
     if (isALPHA(name[0]) && ! (isLEXWARN_on ? ckWARN(WARN_ONCE)
                                            : (PL_dowarn & G_WARN_ON ) ) )
diff --git a/gv.h b/gv.h
index 3140de4..a393262 100644 (file)
--- a/gv.h
+++ b/gv.h
@@ -205,7 +205,8 @@ Return the SV from the GV.
 #define GV_ADD         0x01    /* add, if symbol not already there
                                   For gv_name_set, adding a HEK for the first
                                   time, so don't try to free what's there.  */
-#define GV_ADDMULTI    0x02    /* add, pretending it has been added already */
+#define GV_ADDMULTI    0x02    /* add, pretending it has been added
+                                  already; used also by gv_init_* */
 #define GV_ADDWARN     0x04    /* add, but warn if symbol wasn't already there */
 #define GV_ADDINEVAL   0x08    /* add, as though we're doing so within an eval */
 #define GV_NOINIT      0x10    /* add, but don't init symbol, if type != PVGV */
@@ -226,7 +227,7 @@ Return the SV from the GV.
 #define GV_AUTOLOAD_ISMETHOD 1 /* autoloading a method? */
 
 /*      SVf_UTF8 (more accurately the return value from SvUTF8) is also valid
-       as a flag to gv_fetchpvn_flags and gv_autoload_*, so ensure it lies
+       as a flag to various gv_* functions, so ensure it lies
        outside this range.
 */
 
@@ -240,7 +241,8 @@ Return the SV from the GV.
 #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_init(gv,stash,name,len,multi) gv_init_pvn(gv,stash,name,len,multi,0)
+#define gv_init(gv,stash,name,len,multi) \
+       gv_init_pvn(gv,stash,name,len,GV_ADDMULTI*!!(multi))
 #define gv_fetchmeth(stash,name,len,level) gv_fetchmeth_pvn(stash, name, len, level, 0)
 #define gv_fetchmeth_autoload(stash,name,len,level) gv_fetchmeth_pvn_autoload(stash, name, len, level, 0)
 #define gv_fetchmethod_flags(stash,name,flags) gv_fetchmethod_pv_flags(stash, name, flags)
diff --git a/proto.h b/proto.h
index 52ec378..8a4a73d 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1314,19 +1314,19 @@ PERL_CALLCONV CV*       Perl_gv_handler(pTHX_ HV* stash, I32 id)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_3); */
 
-PERL_CALLCONV void     Perl_gv_init_pv(pTHX_ GV* gv, HV* stash, const char* name, int multi, U32 flags)
+PERL_CALLCONV void     Perl_gv_init_pv(pTHX_ GV* gv, HV* stash, const char* name, U32 flags)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_3);
 #define PERL_ARGS_ASSERT_GV_INIT_PV    \
        assert(gv); assert(name)
 
-PERL_CALLCONV void     Perl_gv_init_pvn(pTHX_ GV* gv, HV* stash, const char* name, STRLEN len, int multi, U32 flags)
+PERL_CALLCONV void     Perl_gv_init_pvn(pTHX_ GV* gv, HV* stash, const char* name, STRLEN len, U32 flags)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_3);
 #define PERL_ARGS_ASSERT_GV_INIT_PVN   \
        assert(gv); assert(name)
 
-PERL_CALLCONV void     Perl_gv_init_sv(pTHX_ GV* gv, HV* stash, SV* namesv, int multi, U32 flags)
+PERL_CALLCONV void     Perl_gv_init_sv(pTHX_ GV* gv, HV* stash, SV* namesv, U32 flags)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_3);
 #define PERL_ARGS_ASSERT_GV_INIT_SV    \