xref: /openbsd/gnu/usr.bin/perl/t/mro/complex_dfs.t (revision e5dd7070) 
1#!./perl
2
3use strict;
4use warnings;
5
6require q(./test.pl); plan(tests => 11);
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 'dfs';
54
55    package Test::B; use mro 'dfs';
56
57    package Test::C; use mro 'dfs';
58
59    package Test::D; use mro 'dfs';
60    use base qw/Test::A Test::B Test::C/;
61
62    package Test::E; use mro 'dfs';
63    use base qw/Test::D/;
64
65    package Test::F; use mro 'dfs';
66    use base qw/Test::E/;
67
68    package Test::G; use mro 'dfs';
69    use base qw/Test::D/;
70
71    package Test::H; use mro 'dfs';
72    use base qw/Test::G/;
73
74    package Test::I; use mro 'dfs';
75    use base qw/Test::H Test::F/;
76
77    package Test::J; use mro 'dfs';
78    use base qw/Test::F/;
79
80    package Test::K; use mro 'dfs';
81    use base qw/Test::J Test::I/;
82}
83
84ok(eq_array(
85    mro::get_linear_isa('Test::A'),
86    [ qw(Test::A) ]
87), '... got the right DFS merge order for Test::A');
88
89ok(eq_array(
90    mro::get_linear_isa('Test::B'),
91    [ qw(Test::B) ]
92), '... got the right DFS merge order for Test::B');
93
94ok(eq_array(
95    mro::get_linear_isa('Test::C'),
96    [ qw(Test::C) ]
97), '... got the right DFS merge order for Test::C');
98
99ok(eq_array(
100    mro::get_linear_isa('Test::D'),
101    [ qw(Test::D Test::A Test::B Test::C) ]
102), '... got the right DFS merge order for Test::D');
103
104ok(eq_array(
105    mro::get_linear_isa('Test::E'),
106    [ qw(Test::E Test::D Test::A Test::B Test::C) ]
107), '... got the right DFS merge order for Test::E');
108
109ok(eq_array(
110    mro::get_linear_isa('Test::F'),
111    [ qw(Test::F Test::E Test::D Test::A Test::B Test::C) ]
112), '... got the right DFS merge order for Test::F');
113
114ok(eq_array(
115    mro::get_linear_isa('Test::G'),
116    [ qw(Test::G Test::D Test::A Test::B Test::C) ]
117), '... got the right DFS merge order for Test::G');
118
119ok(eq_array(
120    mro::get_linear_isa('Test::H'),
121    [ qw(Test::H Test::G Test::D Test::A Test::B Test::C) ]
122), '... got the right DFS merge order for Test::H');
123
124ok(eq_array(
125    mro::get_linear_isa('Test::I'),
126    [ qw(Test::I Test::H Test::G Test::D Test::A Test::B Test::C Test::F Test::E) ]
127), '... got the right DFS merge order for Test::I');
128
129ok(eq_array(
130    mro::get_linear_isa('Test::J'),
131    [ qw(Test::J Test::F Test::E Test::D Test::A Test::B Test::C) ]
132), '... got the right DFS merge order for Test::J');
133
134ok(eq_array(
135    mro::get_linear_isa('Test::K'),
136    [ qw(Test::K Test::J Test::F Test::E Test::D Test::A Test::B Test::C Test::I Test::H Test::G) ]
137), '... got the right DFS merge order for Test::K');
138