diff options
-rw-r--r-- | ext/mro/mro.xs | 15 | ||||
-rw-r--r-- | 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 63befa9d23..acccdd5a3d 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 e77ce7be31..3840a4b882 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'; } |