This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Eliminate the newname param from mro_package_moved
authorFather Chrysostomos <sprout@cpan.org>
Sat, 20 Nov 2010 19:20:07 +0000 (11:20 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 21 Nov 2010 02:15:14 +0000 (18:15 -0800)
Nothing is using this any more, as of the previous commit.

embed.fnc
embed.h
hv.c
mro.c
pp.c
proto.h
sv.c

index 5162991..6245965 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2374,7 +2374,7 @@ s |void   |mro_gather_and_rename|NN HV * const stashes \
 : Used in hv.c, mg.c, pp.c, sv.c
 pd     |void   |mro_isa_changed_in|NN HV* stash
 Apd    |void   |mro_method_changed_in  |NN HV* stash
-pdx    |void   |mro_package_moved      |NULLOK HV * const stash|NULLOK HV * const oldstash|NULLOK const GV *gv|NULLOK const char *newname|I32 newname_len
+pdx    |void   |mro_package_moved      |NULLOK HV * const stash|NULLOK HV * const oldstash|NN const GV * const gv|U32 flags
 : Only used in perl.c
 p      |void   |boot_core_mro
 Apon   |void   |sys_init       |NN int* argc|NN char*** argv
diff --git a/embed.h b/embed.h
index 7516282..51ab229 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define mg_localize(a,b,c)     Perl_mg_localize(aTHX_ a,b,c)
 #define mode_from_discipline(a,b)      Perl_mode_from_discipline(aTHX_ a,b)
 #define mro_isa_changed_in(a)  Perl_mro_isa_changed_in(aTHX_ a)
-#define mro_package_moved(a,b,c,d,e)   Perl_mro_package_moved(aTHX_ a,b,c,d,e)
+#define mro_package_moved(a,b,c,d)     Perl_mro_package_moved(aTHX_ a,b,c,d)
 #define munge_qwlist_to_paren_list(a)  Perl_munge_qwlist_to_paren_list(aTHX_ a)
 #define my_attrs(a,b)          Perl_my_attrs(aTHX_ a,b)
 #define my_clearenv()          Perl_my_clearenv(aTHX)
diff --git a/hv.c b/hv.c
index 1f411e7..376b5dc 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1077,7 +1077,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
        if (mro_changes == 1) mro_isa_changed_in(hv);
        else if (mro_changes == 2)
-           mro_package_moved(NULL, stash, gv, NULL, 1);
+           mro_package_moved(NULL, stash, gv, 1);
 
        return sv;
     }
@@ -1771,7 +1771,7 @@ S_hfreeentries(pTHX_ HV *hv)
                    if (klen > 1 && key[klen-1]==':' && key[klen-2]==':') {
                        mro_package_moved(
                         NULL, GvHV(HeVAL(oentry)),
-                        (GV *)HeVAL(oentry), NULL, 0
+                        (GV *)HeVAL(oentry), 0
                        );
                    }
                }
diff --git a/mro.c b/mro.c
index 8276795..d1b6d2f 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -679,9 +679,7 @@ S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name,
 Call this function to signal to a stash that it has been assigned to
 another spot in the stash hierarchy. C<stash> is the stash that has been
 assigned. C<oldstash> is the stash it replaces, if any. C<gv> is the glob
-that is actually being assigned to. C<newname> and C<newname_len> are the
-full name of the GV. If these last two arguments are omitted, they can be
-inferred from C<gv>. C<gv> can be omitted if C<newname> is given.
+that is actually being assigned to.
 
 This can also be called with a null first argument to
 indicate that C<oldstash> has been deleted.
@@ -694,21 +692,22 @@ It also sets the effective names (C<HvENAME>) on all the stashes as
 appropriate.
 
 If the C<gv> is present and is not in the symbol table, then this function
-simply returns. This checked will be skipped if C<newname_len> is set to 1
-and C<newname> is null.
+simply returns. This checked will be skipped if C<flags & 1>.
 
 =cut
 */
 void
 Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
-                       const GV *gv, const char *newname,
-                       I32 newname_len)
+                       const GV * const gv, U32 flags)
 {
+    SV * const namesv = sv_newmortal();
+    const char * newname;
+    STRLEN newname_len;
     HV *stashes;
     HE* iter;
 
+    PERL_ARGS_ASSERT_MRO_PACKAGE_MOVED;
     assert(stash || oldstash);
-    assert(gv || newname);
 
     /* Determine the name of the location that stash was assigned to
      * or from which oldstash was removed.
@@ -723,20 +722,15 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash,
      *   *$globref = *frelp::;
      *      # calls mro_package_moved(%frelp::, %baz::, *$globref, NULL, 0)
      *
-     * If newname is not null, then we trust that the caller gave us the
-     * right name. Otherwise, we get it from the gv. But if the gv is not
+     * So we get it from the gv. But if the gv is not
      * in the symbol table, then we just return. We skip that check,
-     * however, if newname_len is 1 and newname is null.
+     * however, if flags & 1.
      */
-    if(!newname && gv) {
-       SV * const namesv = sv_newmortal();
-       STRLEN len;
-       gv_fullname4(namesv, gv, NULL, 0);
-       if( newname_len != 1
+    gv_fullname4(namesv, gv, NULL, 0);
+    if( !(flags & 1)
         && gv_fetchsv(namesv, GV_NOADD_NOINIT, SVt_PVGV) != gv ) return;
-       newname = SvPV_const(namesv, len);
-       newname_len = len - 2; /* skip trailing :: */
-    }
+    newname = SvPV_const(namesv, newname_len);
+    newname_len -= 2; /* skip trailing :: */
 
     /* Get a list of all the affected classes. */
     /* We cannot simply pass them all to mro_isa_changed_in to avoid
diff --git a/pp.c b/pp.c
index 9e762d5..297b532 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -892,7 +892,7 @@ PP(pp_undef)
            GvMULTI_on(sv);
 
             if(stash)
-                mro_package_moved(NULL, stash, (const GV *)sv, NULL, 0);
+                mro_package_moved(NULL, stash, (const GV *)sv, 0);
             stash = NULL;
             /* undef *Foo::ISA */
             if( strEQ(GvNAME((const GV *)sv), "ISA")
diff --git a/proto.h b/proto.h
index 2dd44c3..a24a9cb 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2285,7 +2285,11 @@ PERL_CALLCONV void       Perl_mro_method_changed_in(pTHX_ HV* stash)
 #define PERL_ARGS_ASSERT_MRO_METHOD_CHANGED_IN \
        assert(stash)
 
-PERL_CALLCONV void     Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash, const GV *gv, const char *newname, I32 newname_len);
+PERL_CALLCONV void     Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash, const GV * const gv, U32 flags)
+                       __attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_MRO_PACKAGE_MOVED     \
+       assert(gv)
+
 PERL_CALLCONV void     Perl_mro_register(pTHX_ const struct mro_alg *mro)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_MRO_REGISTER  \
diff --git a/sv.c b/sv.c
index 8e4d016..ebec907 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3683,7 +3683,7 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
        if(old_stash ? (HV *)HvENAME_get(old_stash) : stash)
            mro_package_moved(
                stash, old_stash,
-               (GV *)dstr, NULL, 0
+               (GV *)dstr, 0
            );
     }
     else if(mro_changes) mro_method_changed_in(GvSTASH(dstr));
@@ -3801,7 +3801,7 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
            ) {
                mro_package_moved(
                    (HV *)sref, (HV *)dref,
-                   (GV *)dstr, NULL, 0
+                   (GV *)dstr, 0
                );
            }
        }
@@ -4113,7 +4113,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
                    )
                        mro_package_moved(
                         stash, old_stash,
-                        (GV *)dstr, NULL, 0
+                        (GV *)dstr, 0
                        );
                }
            }