Commit | Line | Data |
cbd9f942 |
1 | use strict; |
2 | use warnings; |
3 | |
e97359e7 |
4 | use Test::More tests => 53; |
cbd9f942 |
5 | use Test::Exception; |
6 | |
da88f307 |
7 | use Class::MOP; |
8 | use Class::MOP::Method; |
9 | |
b38f3848 |
10 | my $method = Class::MOP::Method->wrap( |
49ca2e97 |
11 | sub {1}, |
b38f3848 |
12 | package_name => 'main', |
13 | name => '__ANON__', |
14 | ); |
49ca2e97 |
15 | is( $method->meta, Class::MOP::Method->meta, |
16 | '... instance and class both lead to the same meta' ); |
17 | |
18 | is( $method->package_name, 'main', '... our package is main::' ); |
19 | is( $method->name, '__ANON__', '... our sub name is __ANON__' ); |
20 | is( $method->fully_qualified_name, 'main::__ANON__', |
21 | '... our subs full name is main::__ANON__' ); |
22 | is( $method->original_method, undef, '... no original_method ' ); |
23 | is( $method->original_package_name, 'main', |
24 | '... the original_package_name is the same as package_name' ); |
25 | is( $method->original_name, '__ANON__', |
26 | '... the original_name is the same as name' ); |
27 | is( $method->original_fully_qualified_name, 'main::__ANON__', |
28 | '... the original_fully_qualified_name is the same as fully_qualified_name' |
29 | ); |
8048fe76 |
30 | |
49ca2e97 |
31 | dies_ok { Class::MOP::Method->wrap } |
32 | q{... can't call wrap() without some code}; |
33 | dies_ok { Class::MOP::Method->wrap( [] ) } |
34 | q{... can't call wrap() without some code}; |
35 | dies_ok { Class::MOP::Method->wrap( bless {} => 'Fail' ) } |
36 | q{... can't call wrap() without some code}; |
37 | |
38 | dies_ok { Class::MOP::Method->name } |
39 | q{... can't call name() as a class method}; |
40 | dies_ok { Class::MOP::Method->body } |
41 | q{... can't call body() as a class method}; |
42 | dies_ok { Class::MOP::Method->package_name } |
43 | q{... can't call package_name() as a class method}; |
44 | dies_ok { Class::MOP::Method->fully_qualified_name } |
45 | q{... can't call fully_qualified_name() as a class method}; |
8048fe76 |
46 | |
cbd9f942 |
47 | my $meta = Class::MOP::Method->meta; |
49ca2e97 |
48 | isa_ok( $meta, 'Class::MOP::Class' ); |
cbd9f942 |
49 | |
49ca2e97 |
50 | foreach my $method_name ( |
51 | qw( |
a4258ffd |
52 | wrap |
49ca2e97 |
53 | package_name |
54 | name |
55 | ) |
56 | ) { |
57 | ok( $meta->has_method($method_name), |
58 | '... Class::MOP::Method->has_method(' . $method_name . ')' ); |
59 | my $method = $meta->get_method($method_name); |
60 | is( $method->package_name, 'Class::MOP::Method', |
61 | '... our package is Class::MOP::Method' ); |
62 | is( $method->name, $method_name, |
63 | '... our sub name is "' . $method_name . '"' ); |
cbd9f942 |
64 | } |
65 | |
66 | dies_ok { |
49ca2e97 |
67 | Class::MOP::Method->wrap(); |
68 | } |
69 | '... bad args for &wrap'; |
cbd9f942 |
70 | |
71 | dies_ok { |
49ca2e97 |
72 | Class::MOP::Method->wrap('Fail'); |
73 | } |
74 | '... bad args for &wrap'; |
cbd9f942 |
75 | |
76 | dies_ok { |
49ca2e97 |
77 | Class::MOP::Method->wrap( [] ); |
78 | } |
79 | '... bad args for &wrap'; |
b38f3848 |
80 | |
81 | dies_ok { |
49ca2e97 |
82 | Class::MOP::Method->wrap( sub {'FAIL'} ); |
83 | } |
84 | '... bad args for &wrap'; |
b38f3848 |
85 | |
86 | dies_ok { |
49ca2e97 |
87 | Class::MOP::Method->wrap( sub {'FAIL'}, package_name => 'main' ); |
88 | } |
89 | '... bad args for &wrap'; |
b38f3848 |
90 | |
91 | dies_ok { |
49ca2e97 |
92 | Class::MOP::Method->wrap( sub {'FAIL'}, name => '__ANON__' ); |
93 | } |
94 | '... bad args for &wrap'; |
b38f3848 |
95 | |
3ea3a033 |
96 | lives_ok { |
49ca2e97 |
97 | Class::MOP::Method->wrap( bless( sub {'FAIL'}, "Foo" ), |
98 | name => '__ANON__', package_name => 'Foo::Bar' ); |
99 | } |
100 | '... blessed coderef to &wrap'; |
3ea3a033 |
101 | |
2226a8b0 |
102 | my $clone = $method->clone( |
103 | package_name => 'NewPackage', |
104 | name => 'new_name', |
105 | ); |
b38f3848 |
106 | |
49ca2e97 |
107 | isa_ok( $clone, 'Class::MOP::Method' ); |
108 | is( $clone->package_name, 'NewPackage', |
109 | '... cloned method has new package name' ); |
110 | is( $clone->name, 'new_name', '... cloned method has new sub name' ); |
111 | is( $clone->fully_qualified_name, 'NewPackage::new_name', |
112 | '... cloned method has new fq name' ); |
113 | is( $clone->original_method, $method, |
114 | '... cloned method has correct original_method' ); |
115 | is( $clone->original_package_name, 'main', |
116 | '... cloned method has correct original_package_name' ); |
117 | is( $clone->original_name, '__ANON__', |
118 | '... cloned method has correct original_name' ); |
119 | is( $clone->original_fully_qualified_name, 'main::__ANON__', |
120 | '... cloned method has correct original_fully_qualified_name' ); |
55228454 |
121 | |
122 | my $clone2 = $clone->clone( |
123 | package_name => 'NewerPackage', |
124 | name => 'newer_name', |
125 | ); |
126 | |
49ca2e97 |
127 | is( $clone2->package_name, 'NewerPackage', |
128 | '... clone of clone has new package name' ); |
129 | is( $clone2->name, 'newer_name', '... clone of clone has new sub name' ); |
130 | is( $clone2->fully_qualified_name, 'NewerPackage::newer_name', |
131 | '... clone of clone new fq name' ); |
132 | is( $clone2->original_method, $clone, |
133 | '... cloned method has correct original_method' ); |
134 | is( $clone2->original_package_name, 'main', |
135 | '... original_package_name follows clone chain' ); |
136 | is( $clone2->original_name, '__ANON__', |
137 | '... original_name follows clone chain' ); |
138 | is( $clone2->original_fully_qualified_name, 'main::__ANON__', |
139 | '... original_fully_qualified_name follows clone chain' ); |
e97359e7 |
140 | |
141 | Class::MOP::Class->create( |
142 | 'Method::Subclass', |
143 | superclasses => ['Class::MOP::Method'], |
144 | attributes => [ |
145 | Class::MOP::Attribute->new( |
146 | foo => ( |
147 | accessor => 'foo', |
148 | ) |
149 | ), |
150 | ], |
151 | ); |
152 | |
153 | my $wrapped = Method::Subclass->wrap($method, foo => 'bar'); |
154 | isa_ok($wrapped, 'Method::Subclass'); |
155 | isa_ok($wrapped, 'Class::MOP::Method'); |
156 | is($wrapped->foo, 'bar', 'attribute set properly'); |
157 | is($wrapped->package_name, 'main', 'package_name copied properly'); |
158 | is($wrapped->name, '__ANON__', 'method name copied properly'); |
159 | |
160 | my $wrapped2 = Method::Subclass->wrap($method, foo => 'baz', name => 'FOO'); |
161 | is($wrapped2->name, 'FOO', 'got a new method name'); |