Commit | Line | Data |
---|---|---|
e1a479c5 BB |
1 | #!./perl |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | BEGIN { | |
6 | unless (-d 'blib') { | |
7 | chdir 't' if -d 't'; | |
8 | @INC = '../lib'; | |
9 | } | |
10 | } | |
11 | ||
12 | use Test::More tests => 2; | |
13 | ||
14 | =pod | |
15 | ||
16 | This tests a strange bug found by Matt S. Trout | |
17 | while building DBIx::Class. Thanks Matt!!!! | |
18 | ||
19 | <A> | |
20 | / \ | |
21 | <C> <B> | |
22 | \ / | |
23 | <D> | |
24 | ||
25 | =cut | |
26 | ||
27 | { | |
28 | package Diamond_A; | |
29 | use mro 'c3'; | |
30 | ||
31 | sub foo { 'Diamond_A::foo' } | |
32 | } | |
33 | { | |
34 | package Diamond_B; | |
35 | use base 'Diamond_A'; | |
36 | use mro 'c3'; | |
37 | ||
38 | sub foo { 'Diamond_B::foo => ' . (shift)->SUPER::foo } | |
39 | } | |
40 | { | |
41 | package Diamond_C; | |
42 | use mro 'c3'; | |
43 | use base 'Diamond_A'; | |
44 | ||
45 | } | |
46 | { | |
47 | package Diamond_D; | |
48 | use base ('Diamond_C', 'Diamond_B'); | |
49 | use mro 'c3'; | |
50 | ||
51 | sub foo { 'Diamond_D::foo => ' . (shift)->SUPER::foo } | |
52 | } | |
53 | ||
54 | is_deeply( | |
55 | mro::get_linear_isa('Diamond_D'), | |
56 | [ qw(Diamond_D Diamond_C Diamond_B Diamond_A) ], | |
57 | '... got the right MRO for Diamond_D'); | |
58 | ||
59 | is(Diamond_D->foo, | |
60 | 'Diamond_D::foo => Diamond_B::foo => Diamond_A::foo', | |
61 | '... got the right next::method dispatch path'); |