xref: /openbsd/gnu/usr.bin/perl/t/mro/complex_c3.t (revision 17df1aa7) 
1#!./perl
2
3use strict;
4use warnings;
5
6require q(./test.pl); plan(tests => 12);
7
8=pod
9
10This example is taken from: http://rt.cpan.org/Public/Bug/Display.html?id=20879
11
12               ---     ---     ---
13Level 5     8 | A | 9 | B | A | C |    (More General)
14               ---     ---     ---       V
15                  \     |     /          |
16                   \    |    /           |
17                    \   |   /            |
18                     \  |  /             |
19                       ---               |
20Level 4             7 | D |              |
21                       ---               |
22                      /   \              |
23                     /     \             |
24                  ---       ---          |
25Level 3        4 | G |   6 | E |         |
26                  ---       ---          |
27                   |         |           |
28                   |         |           |
29                  ---       ---          |
30Level 2        3 | H |   5 | F |         |
31                  ---       ---          |
32                      \   /  |           |
33                       \ /   |           |
34                        \    |           |
35                       / \   |           |
36                      /   \  |           |
37                  ---       ---          |
38Level 1        1 | J |   2 | I |         |
39                  ---       ---          |
40                    \       /            |
41                     \     /             |
42                       ---               v
43Level 0             0 | K |            (More Specialized)
44                       ---
45
46
470123456789A
48KJIHGFEDABC
49
50=cut
51
52{
53    package Test::A; use mro 'c3';
54
55    package Test::B; use mro 'c3';
56
57    package Test::C; use mro 'c3';
58
59    package Test::D; use mro 'c3';
60    use base qw/Test::A Test::B Test::C/;
61
62    package Test::E; use mro 'c3';
63    use base qw/Test::D/;
64
65    package Test::F; use mro 'c3';
66    use base qw/Test::E/;
67    sub testmeth { "wrong" }
68
69    package Test::G; use mro 'c3';
70    use base qw/Test::D/;
71
72    package Test::H; use mro 'c3';
73    use base qw/Test::G/;
74
75    package Test::I; use mro 'c3';
76    use base qw/Test::H Test::F/;
77    sub testmeth { "right" }
78
79    package Test::J; use mro 'c3';
80    use base qw/Test::F/;
81
82    package Test::K; use mro 'c3';
83    use base qw/Test::J Test::I/;
84    sub testmeth { shift->next::method }
85}
86
87ok(eq_array(
88    mro::get_linear_isa('Test::A'),
89    [ qw(Test::A) ]
90), '... got the right C3 merge order for Test::A');
91
92ok(eq_array(
93    mro::get_linear_isa('Test::B'),
94    [ qw(Test::B) ]
95), '... got the right C3 merge order for Test::B');
96
97ok(eq_array(
98    mro::get_linear_isa('Test::C'),
99    [ qw(Test::C) ]
100), '... got the right C3 merge order for Test::C');
101
102ok(eq_array(
103    mro::get_linear_isa('Test::D'),
104    [ qw(Test::D Test::A Test::B Test::C) ]
105), '... got the right C3 merge order for Test::D');
106
107ok(eq_array(
108    mro::get_linear_isa('Test::E'),
109    [ qw(Test::E Test::D Test::A Test::B Test::C) ]
110), '... got the right C3 merge order for Test::E');
111
112ok(eq_array(
113    mro::get_linear_isa('Test::F'),
114    [ qw(Test::F Test::E Test::D Test::A Test::B Test::C) ]
115), '... got the right C3 merge order for Test::F');
116
117ok(eq_array(
118    mro::get_linear_isa('Test::G'),
119    [ qw(Test::G Test::D Test::A Test::B Test::C) ]
120), '... got the right C3 merge order for Test::G');
121
122ok(eq_array(
123    mro::get_linear_isa('Test::H'),
124    [ qw(Test::H Test::G Test::D Test::A Test::B Test::C) ]
125), '... got the right C3 merge order for Test::H');
126
127ok(eq_array(
128    mro::get_linear_isa('Test::I'),
129    [ qw(Test::I Test::H Test::G Test::F Test::E Test::D Test::A Test::B Test::C) ]
130), '... got the right C3 merge order for Test::I');
131
132ok(eq_array(
133    mro::get_linear_isa('Test::J'),
134    [ qw(Test::J Test::F Test::E Test::D Test::A Test::B Test::C) ]
135), '... got the right C3 merge order for Test::J');
136
137ok(eq_array(
138    mro::get_linear_isa('Test::K'),
139    [ qw(Test::K Test::J Test::I Test::H Test::G Test::F Test::E Test::D Test::A Test::B Test::C) ]
140), '... got the right C3 merge order for Test::K');
141
142is(Test::K->testmeth(), "right", 'next::method working ok');
143