1#!./perl 2 3use strict; 4use warnings; 5 6require q(./test.pl); plan(tests => 2); 7 8=pod 9 10This tests a strange bug found by Matt S. Trout 11while building DBIx::Class. Thanks Matt!!!! 12 13 <A> 14 / \ 15<C> <B> 16 \ / 17 <D> 18 19=cut 20 21{ 22 package Diamond_A; 23 use mro 'dfs'; 24 25 sub foo { 'Diamond_A::foo' } 26} 27{ 28 package Diamond_B; 29 use base 'Diamond_A'; 30 use mro 'dfs'; 31 32 sub foo { 'Diamond_B::foo => ' . (shift)->SUPER::foo } 33} 34{ 35 package Diamond_C; 36 use mro 'dfs'; 37 use base 'Diamond_A'; 38 39} 40{ 41 package Diamond_D; 42 use base ('Diamond_C', 'Diamond_B'); 43 use mro 'dfs'; 44 45 sub foo { 'Diamond_D::foo => ' . (shift)->SUPER::foo } 46} 47 48ok(eq_array( 49 mro::get_linear_isa('Diamond_D'), 50 [ qw(Diamond_D Diamond_C Diamond_A Diamond_B) ] 51), '... got the right MRO for Diamond_D'); 52 53is(Diamond_D->foo, 54 'Diamond_D::foo => Diamond_A::foo', 55 '... got the right next::method dispatch path'); 56