In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/1726bc11330f7a943b1e12c6dd5fa5454b90abd6?hp=1245abf13f772bd2dd1d209bf07773efca954acb>
- Log ----------------------------------------------------------------- commit 1726bc11330f7a943b1e12c6dd5fa5454b90abd6 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 2 08:30:51 2010 -0800 [perl #80098] Bleadperl breaks Attribute::Lexical If @UNIVERSAL::ISA = "a"; and @a::ISA = "b"; then methods are searched for in these orders: main UNIVERSAL a b UNIVERSAL a b UNIVERSAL a b a b UNIVERSAL a b b UNIVERSAL a b For method lookup, looking at a stash twice causes no problems (except for a SUPER bug Iâve just found--to be dealt with separately). My fix to next::method in a5cd004 which made it do a second pass with UNIVERSAL the way gv_fetchmeth does did not take into account that it might return its caller (sub a::foo { return shift->next::can }), causing an infinite loop. This patch makes it check, on the second pass, whether each stash is the stash at the start of the MRO list and breaks if that is the case, so the MROs are effectively: main UNIVERSAL a b UNIVERSAL a b a b UNIVERSAL b UNIVERSAL a (which is what they are effectively already for method lookup). ----------------------------------------------------------------------- Summary of changes: ext/mro/mro.xs | 15 ++++++++------- t/mro/next_edgecases.t | 16 ++++++++++++++-- 2 files changed, 22 insertions(+), 9 deletions(-) diff --git a/ext/mro/mro.xs b/ext/mro/mro.xs index 63befa9..acccdd5 100644 --- a/ext/mro/mro.xs +++ b/ext/mro/mro.xs @@ -482,7 +482,7 @@ mro__nextcan(...) const char *hvname; I32 entries; struct mro_meta* selfmeta; - bool seen_univ = FALSE; + bool searching_univ = FALSE; HV* nmcache; I32 i; PPCODE: @@ -633,9 +633,7 @@ mro__nextcan(...) assert(curstash); - if (!seen_univ && SvCUR(linear_sv) == 9 - && strnEQ(SvPV_nolen_const(linear_sv), "UNIVERSAL", 9)) - seen_univ = TRUE; + if (searching_univ && curstash == selfstash) break; gvp = (GV**)hv_fetch(curstash, subname, subname_len, 0); if (!gvp) continue; @@ -658,12 +656,15 @@ mro__nextcan(...) } } - if (!seen_univ && (selfstash = gv_stashpvn("UNIVERSAL", 9, 0))) { - linear_av = S_mro_get_linear_isa_c3(aTHX_ selfstash, 0); + if (!searching_univ) { + HV * const unistash = gv_stashpvn("UNIVERSAL", 9, 0); + if (unistash) { + linear_av = S_mro_get_linear_isa_c3(aTHX_ unistash, 0); linear_svp = AvARRAY(linear_av); entries = AvFILLp(linear_av) + 1; - seen_univ = TRUE; + searching_univ = TRUE; goto retry; + } } (void)hv_store_ent(nmcache, sv, &PL_sv_undef, 0); diff --git a/t/mro/next_edgecases.t b/t/mro/next_edgecases.t index e77ce7b..3840a4b 100644 --- a/t/mro/next_edgecases.t +++ b/t/mro/next_edgecases.t @@ -5,7 +5,7 @@ use warnings; BEGIN { chdir 't'; require q(./test.pl); @INC = qw "../lib lib" } -plan(tests => 14); +plan(tests => 17); { @@ -94,13 +94,15 @@ plan(tests => 14); } -# Test next::method with UNIVERSAL methods +# Test next::method/can with UNIVERSAL methods { package UNIVERSAL; sub foo { "foo" } + sub kan { shift->next::can } our @ISA = "a"; package a; sub bar { "bar" } + sub baz { shift->next::can } package M; sub foo { shift->next::method } sub bar { shift->next::method } @@ -108,4 +110,14 @@ plan(tests => 14); is eval { M->foo }, "foo", 'next::method with implicit UNIVERSAL'; is eval { M->bar }, "bar", 'n::m w/superclass of implicit UNIVERSAL'; + + is baz a, undef, + 'univ superclasses next::cannot their own methods'; + is kan UNIVERSAL, undef, + 'UNIVERSAL next::cannot its own methods'; + + @a::ISA = 'b'; + sub b::cnadd { shift->next::can } + is baz b, \&a::baz, + 'univ supersuperclass noxt::can method in its immediate subclasses'; } -- Perl5 Master Repository
