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