1#!./perl
2
3use strict;
4use warnings;
5
6require q(./test.pl); plan(tests => 4);
7
8=pod
9
10This example is take from: http://www.python.org/2.3/mro.html
11
12"My second example"
13class O: pass
14class F(O): pass
15class E(O): pass
16class D(O): pass
17class C(D,F): pass
18class B(E,D): pass
19class A(B,C): pass
20
21                           6
22                          ---
23Level 3                  | O |
24                       /  ---  \
25                      /    |    \
26                     /     |     \
27                    /      |      \
28                  ---     ---    ---
29Level 2        2 | E | 4 | D |  | F | 5
30                  ---     ---    ---
31                   \      / \     /
32                    \    /   \   /
33                     \  /     \ /
34                      ---     ---
35Level 1            1 | B |   | C | 3
36                      ---     ---
37                       \       /
38                        \     /
39                          ---
40Level 0                0 | A |
41                          ---
42
43>>> A.mro()
44(<class '__main__.A'>, <class '__main__.B'>, <class '__main__.E'>,
45<class '__main__.C'>, <class '__main__.D'>, <class '__main__.F'>,
46<type 'object'>)
47
48=cut
49
50{
51    package Test::O;
52    use mro 'dfs';
53
54    sub O_or_D { 'Test::O' }
55    sub O_or_F { 'Test::O' }
56
57    package Test::F;
58    use base 'Test::O';
59    use mro 'dfs';
60
61    sub O_or_F { 'Test::F' }
62
63    package Test::E;
64    use base 'Test::O';
65    use mro 'dfs';
66
67    package Test::D;
68    use base 'Test::O';
69    use mro 'dfs';
70
71    sub O_or_D { 'Test::D' }
72    sub C_or_D { 'Test::D' }
73
74    package Test::C;
75    use base ('Test::D', 'Test::F');
76    use mro 'dfs';
77
78    sub C_or_D { 'Test::C' }
79
80    package Test::B;
81    use base ('Test::E', 'Test::D');
82    use mro 'dfs';
83
84    package Test::A;
85    use base ('Test::B', 'Test::C');
86    use mro 'dfs';
87}
88
89ok(eq_array(
90    mro::get_linear_isa('Test::A'),
91    [ qw(Test::A Test::B Test::E Test::O Test::D Test::C Test::F) ]
92), '... got the right MRO for Test::A');
93
94is(Test::A->O_or_D, 'Test::O', '... got the right method dispatch');
95is(Test::A->O_or_F, 'Test::O', '... got the right method dispatch');
96
97# NOTE:
98# this test is particularly interesting because the p5 dispatch
99# would actually call Test::D before Test::C and Test::D is a
100# subclass of Test::C
101is(Test::A->C_or_D, 'Test::D', '... got the right method dispatch');
102