[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).

diff --git a/ext/mro/mro.xs b/ext/mro/mro.xs
index 63befa9..acccdd5 100644 (file)
--- 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 (file)
--- 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';
 }