Commit | Line | Data |
38bf2a25 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | |
6 | use Class::MOP; |
7 | |
8 | { |
9 | |
10 | package Origin; |
11 | sub bar { ( caller(0) )[3] } |
12 | |
13 | package Foo; |
14 | } |
15 | |
16 | my $Foo = Class::MOP::Class->initialize('Foo'); |
17 | |
18 | $Foo->add_method( foo => sub { ( caller(0) )[3] } ); |
19 | |
20 | is_deeply( |
21 | [ Class::MOP::get_code_info( $Foo->get_method('foo')->body ) ], |
22 | [ "Foo", "foo" ], |
23 | "subname applied to anonymous method", |
24 | ); |
25 | |
26 | is( Foo->foo, "Foo::foo", "caller() aggrees" ); |
27 | |
28 | $Foo->add_method( bar => \&Origin::bar ); |
29 | |
30 | is( Origin->bar, "Origin::bar", "normal caller() operation in unrelated class" ); |
31 | |
32 | is_deeply( |
33 | [ Class::MOP::get_code_info( $Foo->get_method('foo')->body ) ], |
34 | [ "Foo", "foo" ], |
35 | "subname not applied if a name already exists", |
36 | ); |
37 | |
38 | is( Foo->bar, "Origin::bar", "caller aggrees" ); |
39 | |
40 | is( Origin->bar, "Origin::bar", "unrelated class untouched" ); |
41 | |
42 | done_testing; |