Commit | Line | Data |
d0e2efe5 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
ef29cd70 |
6 | use Test::More tests => 4; |
d0e2efe5 |
7 | |
8 | =pod |
9 | |
10 | Start with this: |
11 | |
12 | <A> |
13 | / \ |
14 | <B> <C> |
15 | \ / |
16 | <D> |
17 | |
18 | =cut |
19 | |
20 | { |
21 | package Diamond_A; |
22 | use Class::C3; |
23 | sub hello { 'Diamond_A::hello' } |
24 | } |
25 | { |
26 | package Diamond_B; |
27 | use base 'Diamond_A'; |
28 | use Class::C3; |
29 | } |
30 | { |
31 | package Diamond_C; |
32 | use Class::C3; |
33 | use base 'Diamond_A'; |
34 | sub hello { 'Diamond_C::hello' } |
35 | } |
36 | { |
37 | package Diamond_D; |
38 | use base ('Diamond_B', 'Diamond_C'); |
39 | use Class::C3; |
40 | } |
41 | |
2ffffc6d |
42 | Class::C3::initialize(); |
43 | |
d0e2efe5 |
44 | is_deeply( |
45 | [ Class::C3::calculateMRO('Diamond_D') ], |
46 | [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ], |
47 | '... got the right MRO for Diamond_D'); |
48 | |
49 | =pod |
50 | |
51 | Then change it to this: |
52 | |
53 | <E> <A> |
54 | \ / \ |
55 | <B> <C> |
56 | \ / |
57 | <D> |
58 | |
59 | =cut |
60 | |
61 | { |
62 | package Diamond_E; |
63 | use Class::C3; |
64 | sub hello { 'Diamond_E::hello' } |
65 | } |
66 | |
67 | { |
68 | no strict 'refs'; |
69 | unshift @{"Diamond_B::ISA"} => 'Diamond_E'; |
70 | } |
71 | |
72 | is_deeply( |
73 | [ Class::C3::calculateMRO('Diamond_D') ], |
74 | [ qw(Diamond_D Diamond_B Diamond_E Diamond_C Diamond_A) ], |
75 | '... got the new MRO for Diamond_D'); |
76 | |
7f657ca3 |
77 | # Doesn't work with core support, since reinit is not neccesary and the change |
78 | # takes effect immediately |
79 | SKIP: { |
80 | skip "This test does not work with a c3-patched perl interpreter", 1 |
81 | if $Class::C3::C3_IN_CORE; |
82 | is(Diamond_D->hello, 'Diamond_C::hello', '... method still resolves with old MRO'); |
83 | } |
d0e2efe5 |
84 | |
85 | Class::C3::reinitialize(); |
86 | |
87 | is(Diamond_D->hello, 'Diamond_E::hello', '... method resolves with reinitialized MRO'); |