Commit | Line | Data |
2de3231b |
1 | use strict; |
2 | use warnings; |
a28e50e4 |
3 | use Test::More; |
2de3231b |
4 | |
5dea9f06 |
5 | { |
2de3231b |
6 | package Ball; |
7 | use Moose; |
5dea9f06 |
8 | } |
2de3231b |
9 | |
5dea9f06 |
10 | { |
2de3231b |
11 | package Arbitrary::Roll; |
12 | use Moose::Role; |
5dea9f06 |
13 | } |
2de3231b |
14 | |
15 | my $method_meta = Moose::Meta::Class->create_anon_class( |
16 | superclasses => ['Moose::Meta::Method'], |
17 | roles => ['Arbitrary::Roll'], |
18 | ); |
19 | |
20 | # For comparing identity without actually keeping $original_meta around |
21 | my $original_meta = "$method_meta"; |
22 | |
a5c5516f |
23 | my $method_class = $method_meta->name; |
2de3231b |
24 | |
25 | my $method_object = $method_class->wrap( |
a5c5516f |
26 | sub {'ok'}, |
2de3231b |
27 | associated_metaclass => Ball->meta, |
28 | package_name => 'Ball', |
29 | name => 'bounce', |
30 | ); |
31 | |
a5c5516f |
32 | Ball->meta->add_method( bounce => $method_object ); |
2de3231b |
33 | |
9b47d013 |
34 | for ( 1, 2 ) { |
35 | is( Ball->bounce, 'ok', "method still exists on Ball" ); |
36 | is( Ball->meta->get_method('bounce')->meta->name, $method_class, |
37 | "method's package still exists" ); |
8eaf26e6 |
38 | |
78b26cc6 |
39 | is( Ball->meta->get_method('bounce'), $method_object, |
40 | 'original method object is preserved' ); |
41 | |
9b47d013 |
42 | is( Ball->meta->get_method('bounce')->meta . '', $original_meta, |
43 | "method's metaclass still exists" ); |
44 | ok( Ball->meta->get_method('bounce')->meta->does_role('Arbitrary::Roll'), |
45 | "method still does Arbitrary::Roll" ); |
2de3231b |
46 | |
2de3231b |
47 | undef $method_meta; |
9b47d013 |
48 | } |
a28e50e4 |
49 | |
50 | done_testing; |