In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1375cf1cf2085f851bb176047d5e60248542f555?hp=8ad0ee873ef9de8fbabd98634b89c1b6aca1233a>
- Log ----------------------------------------------------------------- commit 1375cf1cf2085f851bb176047d5e60248542f555 Author: Nicholas Clark <[email protected]> Date: Sat Jul 25 17:04:29 2009 +0100 When resetting our children, wipe out the isa cache too. (Fix to change 34354, which introduced a cached hash to make ->isa O(1)) M mro.c commit 7d88e6c43c2bbc666364eda2fbdc0dd431ac3dcf Author: Nicholas Clark <[email protected]> Date: Sat Jul 25 17:03:21 2009 +0100 When dumping a hash, display the mro_meta structure if present. M dump.c ----------------------------------------------------------------------- Summary of changes: dump.c | 36 ++++++++++++++++++++++++++++++++++++ mro.c | 6 +++++- 2 files changed, 41 insertions(+), 1 deletions(-) diff --git a/dump.c b/dump.c index 79acd09..af735b5 100644 --- a/dump.c +++ b/dump.c @@ -1750,12 +1750,48 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (SvOOK(sv)) { AV * const backrefs = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv)); + struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta; if (backrefs) { Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n", PTR2UV(backrefs)); do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest, dumpops, pvlim); } + if (meta) { + /* FIXME - mro_algs kflags can signal a UTF-8 name. */ + Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%.*s\" (0x%"UVxf")\n", + (int)meta->mro_which->length, + meta->mro_which->name, + PTR2UV(meta->mro_which)); + Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n", + (UV)meta->cache_gen); + Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n", + (UV)meta->pkg_gen); + if (meta->mro_linear_all) { + Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n", + PTR2UV(meta->mro_linear_all)); + do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest, + dumpops, pvlim); + } + if (meta->mro_linear_current) { + Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n", + PTR2UV(meta->mro_linear_current)); + do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest, + dumpops, pvlim); + } + if (meta->mro_nextmethod) { + Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n", + PTR2UV(meta->mro_nextmethod)); + do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest, + dumpops, pvlim); + } + if (meta->isa) { + Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n", + PTR2UV(meta->isa)); + do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest, + dumpops, pvlim); + } + } } if (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */ HE *he; diff --git a/mro.c b/mro.c index fe77647..23f8c07 100644 --- a/mro.c +++ b/mro.c @@ -438,7 +438,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) if(meta->mro_nextmethod) hv_clear(meta->mro_nextmethod); /* Iterate the isarev (classes that are our children), - wiping out their linearization and method caches */ + wiping out their linearization, method and isa caches */ if(isarev) { hv_iterinit(isarev); while((iter = hv_iternext(isarev))) { @@ -463,6 +463,10 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) revmeta->cache_gen++; if(revmeta->mro_nextmethod) hv_clear(revmeta->mro_nextmethod); + if (revmeta->isa) { + SvREFCNT_dec(revmeta->isa); + revmeta->isa = NULL; + } } } -- Perl5 Master Repository
