Merge branch 'master' into immutable_as_real_trait
[gitmo/Class-MOP.git] / t / 030_method.t
CommitLineData
cbd9f942 1use strict;
2use warnings;
3
3ea3a033 4use Test::More tests => 47;
cbd9f942 5use Test::Exception;
6
da88f307 7use Class::MOP;
8use Class::MOP::Method;
9
cbd9f942 10
b38f3848 11my $method = Class::MOP::Method->wrap(
12 sub { 1 },
13 package_name => 'main',
14 name => '__ANON__',
15);
de19f115 16is($method->meta, Class::MOP::Method->meta, '... instance and class both lead to the same meta');
17
18is($method->package_name, 'main', '... our package is main::');
19is($method->name, '__ANON__', '... our sub name is __ANON__');
d41e86f2 20is($method->fully_qualified_name, 'main::__ANON__', '... our subs full name is main::__ANON__');
2226a8b0 21is($method->original_method, undef, '... no original_method ');
22is($method->original_package_name, 'main', '... the original_package_name is the same as package_name');
23is($method->original_name, '__ANON__', '... the original_name is the same as name');
24is($method->original_fully_qualified_name, 'main::__ANON__', '... the original_fully_qualified_name is the same as fully_qualified_name');
22286063 25
bf3db0fb 26dies_ok { Class::MOP::Method->wrap } q{... can't call wrap() without some code};
27dies_ok { Class::MOP::Method->wrap([]) } q{... can't call wrap() without some code};
28dies_ok { Class::MOP::Method->wrap(bless {} => 'Fail') } q{... can't call wrap() without some code};
8048fe76 29
da88f307 30dies_ok { Class::MOP::Method->name } q{... can't call name() as a class method};
31dies_ok { Class::MOP::Method->body } q{... can't call body() as a class method};
32dies_ok { Class::MOP::Method->package_name } q{... can't call package_name() as a class method};
33dies_ok { Class::MOP::Method->fully_qualified_name } q{... can't call fully_qualified_name() as a class method};
8048fe76 34
cbd9f942 35my $meta = Class::MOP::Method->meta;
36isa_ok($meta, 'Class::MOP::Class');
37
de19f115 38foreach my $method_name (qw(
a4258ffd 39 wrap
de19f115 40 package_name
41 name
42 )) {
43 ok($meta->has_method($method_name), '... Class::MOP::Method->has_method(' . $method_name . ')');
44 my $method = $meta->get_method($method_name);
45 is($method->package_name, 'Class::MOP::Method', '... our package is Class::MOP::Method');
46 is($method->name, $method_name, '... our sub name is "' . $method_name . '"');
cbd9f942 47}
48
49dies_ok {
a4258ffd 50 Class::MOP::Method->wrap()
cbd9f942 51} '... bad args for &wrap';
52
53dies_ok {
a4258ffd 54 Class::MOP::Method->wrap('Fail')
cbd9f942 55} '... bad args for &wrap';
56
57dies_ok {
a4258ffd 58 Class::MOP::Method->wrap([])
b38f3848 59} '... bad args for &wrap';
60
61dies_ok {
62 Class::MOP::Method->wrap(sub { 'FAIL' })
63} '... bad args for &wrap';
64
65dies_ok {
66 Class::MOP::Method->wrap(sub { 'FAIL' }, package_name => 'main')
67} '... bad args for &wrap';
68
69dies_ok {
70 Class::MOP::Method->wrap(sub { 'FAIL' }, name => '__ANON__')
71} '... bad args for &wrap';
72
3ea3a033 73lives_ok {
74 Class::MOP::Method->wrap(bless(sub { 'FAIL' }, "Foo"), name => '__ANON__', package_name => 'Foo::Bar')
75} '... blessed coderef to &wrap';
76
2226a8b0 77my $clone = $method->clone(
78 package_name => 'NewPackage',
79 name => 'new_name',
80);
b38f3848 81
2226a8b0 82isa_ok($clone, 'Class::MOP::Method');
55228454 83is($clone->package_name, 'NewPackage', '... cloned method has new package name');
2226a8b0 84is($clone->name, 'new_name', '... cloned method has new sub name');
85is($clone->fully_qualified_name, 'NewPackage::new_name', '... cloned method has new fq name');
86is($clone->original_method, $method, '... cloned method has correct original_method');
87is($clone->original_package_name, 'main', '... cloned method has correct original_package_name');
88is($clone->original_name, '__ANON__', '... cloned method has correct original_name');
89is($clone->original_fully_qualified_name, 'main::__ANON__', '... cloned method has correct original_fully_qualified_name');
55228454 90
91my $clone2 = $clone->clone(
92 package_name => 'NewerPackage',
93 name => 'newer_name',
94);
95
96is($clone2->package_name, 'NewerPackage', '... clone of clone has new package name');
97is($clone2->name, 'newer_name', '... clone of clone has new sub name');
98is($clone2->fully_qualified_name, 'NewerPackage::newer_name', '... clone of clone new fq name');
99is($clone2->original_method, $clone, '... cloned method has correct original_method');
100is($clone2->original_package_name, 'main', '... original_package_name follows clone chain');
101is($clone2->original_name, '__ANON__', '... original_name follows clone chain');
102is($clone2->original_fully_qualified_name, 'main::__ANON__', '... original_fully_qualified_name follows clone chain');