diff options
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | hv.c | 4 | ||||
| -rw-r--r-- | mro.c | 32 | ||||
| -rw-r--r-- | pp.c | 2 | ||||
| -rw-r--r-- | proto.h | 6 | ||||
| -rw-r--r-- | sv.c | 6 |
7 files changed, 26 insertions, 28 deletions
@@ -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 @@ -1056,7 +1056,7 @@ #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) @@ -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 ); } } @@ -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 @@ -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") @@ -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 \ @@ -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 ); } } |