diff options
| -rw-r--r-- | gv.c | 42 | ||||
| -rw-r--r-- | lib/overload/numbers.pm | 2 | ||||
| -rw-r--r-- | mro.c | 6 | ||||
| -rw-r--r-- | overload.c | 6 | ||||
| -rw-r--r-- | overload.h | 1 | ||||
| -rw-r--r-- | perl.h | 4 | ||||
| -rw-r--r-- | regen/overload.pl | 2 | ||||
| -rw-r--r-- | sv.c | 15 |
8 files changed, 30 insertions, 48 deletions
@@ -2252,7 +2252,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) if (mg) { const AMT * const amtp = (AMT*)mg->mg_ptr; if (amtp->was_ok_sub == newgen) { - return AMT_OVERLOADED(amtp) ? 1 : 0; + return AMT_AMAGIC(amtp) ? 1 : 0; } sv_unmagic(MUTABLE_SV(stash), PERL_MAGIC_overload_table); } @@ -2265,8 +2265,8 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) amt.flags = 0; { - int filled = 0, have_ovl = 0; - int i, lim = 1; + int filled = 0; + int i; /* Work with "fallback" key, which we assume to be first in PL_AMG_names */ @@ -2278,7 +2278,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) if (!gv) { if (!gv_fetchmeth_pvn(stash, "((", 2, -1, 0)) - lim = DESTROY_amg; /* Skip overloading entries. */ + goto no_table; } #ifdef PERL_DONT_CREATE_GVSV else if (!sv) { @@ -2292,19 +2292,15 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) else if (SvOK(sv)) { amt.fallback=AMGfallNEVER; filled = 1; - have_ovl = 1; } else { filled = 1; - have_ovl = 1; } - for (i = 1; i < lim; i++) - amt.table[i] = NULL; - for (; i < NofAMmeth; i++) { + for (i = 1; i < NofAMmeth; i++) { const char * const cooky = PL_AMG_names[i]; /* Human-readable form, for debugging: */ - const char * const cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i)); + const char * const cp = AMG_id2name(i); const STRLEN l = PL_AMG_namelens[i]; DEBUG_o( Perl_deb(aTHX_ "Checking overloading of \"%s\" in package \"%.256s\"\n", @@ -2316,10 +2312,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) then we could have created stubs for "(+0" in A and C too. But if B overloads "bool", we may want to use it for numifying instead of C's "+0". */ - if (i >= DESTROY_amg) - gv = Perl_gv_fetchmeth_pvn_autoload(aTHX_ stash, cooky, l, 0, 0); - else /* Autoload taken care of below */ - gv = Perl_gv_fetchmeth_pvn(aTHX_ stash, cooky, l, -1, 0); + gv = Perl_gv_fetchmeth_pvn(aTHX_ stash, cooky, l, -1, 0); cv = 0; if (gv && (cv = GvCV(gv))) { if(GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")){ @@ -2365,8 +2358,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) cp, HvNAME_get(stash), HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv))) ); filled = 1; - if (i < DESTROY_amg) - have_ovl = 1; } else if (gv) { /* Autoloaded... */ cv = MUTABLE_CV(gv); filled = 1; @@ -2375,15 +2366,13 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) } if (filled) { AMT_AMAGIC_on(&amt); - if (have_ovl) - AMT_OVERLOADED_on(&amt); sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table, (char*)&amt, sizeof(AMT)); - return have_ovl; + return TRUE; } } /* Here we have no table: */ - /* no_table: */ + no_table: AMT_AMAGIC_off(&amt); sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table, (char*)&amt, sizeof(AMTS)); @@ -2409,19 +2398,8 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id) mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table); if (!mg) { do_update: - /* If we're looking up a destructor to invoke, we must avoid - * that Gv_AMupdate croaks, because we might be dying already */ - if (Gv_AMupdate(stash, cBOOL(id == DESTROY_amg)) == -1) { - /* and if it didn't found a destructor, we fall back - * to a simpler method that will only look for the - * destructor instead of the whole magic */ - if (id == DESTROY_amg) { - GV * const gv = gv_fetchmethod(stash, "DESTROY"); - if (gv) - return GvCV(gv); - } + if (Gv_AMupdate(stash, 0) == -1) return NULL; - } mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table); } assert(mg); diff --git a/lib/overload/numbers.pm b/lib/overload/numbers.pm index f56fa630cc..a90c175db9 100644 --- a/lib/overload/numbers.pm +++ b/lib/overload/numbers.pm @@ -82,7 +82,6 @@ our @names = qw# (~~ (-X (qr - DESTROY #; our @enums = qw# @@ -154,7 +153,6 @@ our @enums = qw# smart ftest regexp - DESTROY #; { my $i = 0; our %names = map { $_ => $i++ } @names } @@ -544,6 +544,9 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) /* Changes to @ISA might turn overloading on */ HvAMAGIC_on(stash); + /* DESTROY can be cached in SvSTASH. */ + if (!SvOBJECT(stash)) SvSTASH(stash) = NULL; + /* Iterate the isarev (classes that are our children), wiping out their linearization, method and isa caches and upating PL_isarev. */ @@ -1327,6 +1330,9 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) /* Inc the package generation, since a local method changed */ HvMROMETA(stash)->pkg_gen++; + /* DESTROY can be cached in SvSTASH. */ + if (!SvOBJECT(stash)) SvSTASH(stash) = NULL; + /* If stash is UNIVERSAL, or one of UNIVERSAL's parents, invalidate all method caches globally */ if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL")) diff --git a/overload.c b/overload.c index 91e2d20bb4..cd28df4c93 100644 --- a/overload.c +++ b/overload.c @@ -84,8 +84,7 @@ static const U8 PL_AMG_namelens[NofAMmeth] = { 3, 3, 3, - 3, - 7 + 3 }; static const char * const PL_AMG_names[NofAMmeth] = { @@ -161,8 +160,7 @@ static const char * const PL_AMG_names[NofAMmeth] = { "(.=", /* concat_ass */ "(~~", /* smart */ "(-X", /* ftest */ - "(qr", /* regexp */ - "DESTROY" + "(qr" }; /* ex: set ro: */ diff --git a/overload.h b/overload.h index 24cde2ad13..1628ac0025 100644 --- a/overload.h +++ b/overload.h @@ -82,7 +82,6 @@ enum { smart_amg, /* 0x41 ~~ */ ftest_amg, /* 0x42 -X */ regexp_amg, /* 0x43 qr */ - DESTROY_amg, /* 0x44 DESTROY */ max_amg_code /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */ }; @@ -5240,13 +5240,9 @@ typedef struct am_table_short AMTS; #define AMGfallYES 3 #define AMTf_AMAGIC 1 -#define AMTf_OVERLOADED 2 #define AMT_AMAGIC(amt) ((amt)->flags & AMTf_AMAGIC) #define AMT_AMAGIC_on(amt) ((amt)->flags |= AMTf_AMAGIC) #define AMT_AMAGIC_off(amt) ((amt)->flags &= ~AMTf_AMAGIC) -#define AMT_OVERLOADED(amt) ((amt)->flags & AMTf_OVERLOADED) -#define AMT_OVERLOADED_on(amt) ((amt)->flags |= AMTf_OVERLOADED) -#define AMT_OVERLOADED_off(amt) ((amt)->flags &= ~AMTf_OVERLOADED) #define StashHANDLER(stash,meth) gv_handler((stash),CAT2(meth,_amg)) diff --git a/regen/overload.pl b/regen/overload.pl index 652b2b7b86..6d9e04d944 100644 --- a/regen/overload.pl +++ b/regen/overload.pl @@ -198,5 +198,3 @@ concat_ass (.= smart (~~ ftest (-X regexp (qr -# Note: Perl_Gv_AMupdate() assumes that DESTROY is the last entry -DESTROY DESTROY @@ -6332,9 +6332,17 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) { dSP; HV* stash; do { - CV* destructor; - stash = SvSTASH(sv); - destructor = StashHANDLER(stash,DESTROY); + if ((stash = SvSTASH(sv)) && HvNAME(stash)) { + CV* destructor = NULL; + if (!SvOBJECT(stash)) destructor = (CV *)SvSTASH(stash); + if (!destructor) { + GV * const gv = + gv_fetchmeth_autoload(stash, "DESTROY", 7, 0); + if (gv && (destructor = GvCV(gv))) { + if (!SvOBJECT(stash)) + SvSTASH(stash) = (HV *)destructor; + } + } if (destructor /* A constant subroutine can have no side effects, so don't bother calling it. */ @@ -6374,6 +6382,7 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) { } SvREFCNT_dec(tmpref); } + } } while (SvOBJECT(sv) && SvSTASH(sv) != stash); |