xref: /openbsd/gnu/usr.bin/perl/t/mro/basic_05_c3.t (revision 73471bf0) 
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 'c3';
24
25    sub foo { 'Diamond_A::foo' }
26}
27{
28    package Diamond_B;
29    use base 'Diamond_A';
30    use mro 'c3';
31
32    sub foo { 'Diamond_B::foo => ' . (shift)->SUPER::foo }
33}
34{
35    package Diamond_C;
36    use mro 'c3';
37    use base 'Diamond_A';
38
39}
40{
41    package Diamond_D;
42    use base ('Diamond_C', 'Diamond_B');
43    use mro 'c3';
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_B Diamond_A) ]
51), '... got the right MRO for Diamond_D');
52
53is(Diamond_D->foo,
54   'Diamond_D::foo => Diamond_B::foo => Diamond_A::foo',
55   '... got the right next::method dispatch path');
56