Commit | Line | Data |
60ad2cb7 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 15; |
7 | |
8 | |
9 | |
10 | =pod |
11 | |
12 | This just tests the interaction of override/super |
13 | with non-Mouse superclasses. It really should not |
14 | cause issues, the only thing it does is to create |
15 | a metaclass for Foo so that it can find the right |
16 | super method. |
17 | |
18 | This may end up being a sensitive issue for some |
19 | non-Mouse classes, but in 99% of the cases it |
20 | should be just fine. |
21 | |
22 | =cut |
23 | |
24 | { |
25 | package Foo; |
26 | use strict; |
27 | use warnings; |
28 | |
29 | sub new { bless {} => shift() } |
30 | |
31 | sub foo { 'Foo::foo' } |
32 | sub bar { 'Foo::bar' } |
33 | sub baz { 'Foo::baz' } |
34 | |
35 | package Bar; |
36 | use Mouse; |
37 | |
38 | extends 'Foo'; |
39 | |
40 | override bar => sub { 'Bar::bar -> ' . super() }; |
41 | |
42 | package Baz; |
43 | use Mouse; |
44 | |
45 | extends 'Bar'; |
46 | |
47 | override bar => sub { 'Baz::bar -> ' . super() }; |
48 | override baz => sub { 'Baz::baz -> ' . super() }; |
49 | } |
50 | |
51 | my $baz = Baz->new(); |
52 | isa_ok($baz, 'Baz'); |
53 | isa_ok($baz, 'Bar'); |
54 | isa_ok($baz, 'Foo'); |
55 | |
56 | is($baz->foo(), 'Foo::foo', '... got the right value from &foo'); |
57 | is($baz->bar(), 'Baz::bar -> Bar::bar -> Foo::bar', '... got the right value from &bar'); |
58 | is($baz->baz(), 'Baz::baz -> Foo::baz', '... got the right value from &baz'); |
59 | |
60 | my $bar = Bar->new(); |
61 | isa_ok($bar, 'Bar'); |
62 | isa_ok($bar, 'Foo'); |
63 | |
64 | is($bar->foo(), 'Foo::foo', '... got the right value from &foo'); |
65 | is($bar->bar(), 'Bar::bar -> Foo::bar', '... got the right value from &bar'); |
66 | is($bar->baz(), 'Foo::baz', '... got the right value from &baz'); |
67 | |
68 | my $foo = Foo->new(); |
69 | isa_ok($foo, 'Foo'); |
70 | |
71 | is($foo->foo(), 'Foo::foo', '... got the right value from &foo'); |
72 | is($foo->bar(), 'Foo::bar', '... got the right value from &bar'); |
73 | is($foo->baz(), 'Foo::baz', '... got the right value from &baz'); |