6 use Test::More tests => 38;
11 use_ok('Class::MOP::Class');
14 { # This package tries to test &has_method
15 # as exhaustively as possible. More corner
16 # cases are welcome :)
20 use Scalar::Util 'blessed';
22 use constant FOO_CONSTANT => 'Foo-CONSTANT';
24 # define a sub in package
25 sub bar { 'Foo::bar' }
28 { # method named with Sub::Name inside the package scope
30 *{'Foo::floob'} = Sub::Name::subname 'floob' => sub { '!floob!' };
33 # We hateses the "used only once" warnings
34 { my $temp = \&Foo::baz }
38 sub Foo::blah { $_[0]->Foo::baz() }
42 *{'Foo::bling'} = sub { '$$Bling$$' };
43 *{'Foo::bang'} = Sub::Name::subname 'Foo::bang' => sub { '!BANG!' };
44 *{'Foo::boom'} = Sub::Name::subname 'boom' => sub { '!BOOM!' };
46 eval "package Foo; sub evaled_foo { 'Foo::evaled_foo' }";
50 my $Foo = Class::MOP::Class->initialize('Foo');
52 my $foo = sub { 'Foo::foo' };
55 $Foo->add_method('foo' => $foo);
56 } '... we added the method successfully';
58 ok($Foo->has_method('foo'), '... Foo->has_method(foo) (defined with Sub::Name)');
60 is($Foo->get_method('foo'), $foo, '... Foo->get_method(foo) == \&foo');
61 is(Foo->foo(), 'Foo::foo', '... Foo->foo() returns "Foo::foo"');
63 # now check all our other items ...
65 ok($Foo->has_method('FOO_CONSTANT'), '... Foo->has_method(FOO_CONSTANT) (defined w/ use constant)');
66 ok($Foo->has_method('bar'), '... Foo->has_method(bar) (defined in Foo)');
67 ok($Foo->has_method('baz'), '... Foo->has_method(baz) (typeglob aliased within Foo)');
68 ok($Foo->has_method('floob'), '... Foo->has_method(floob) (defined in Foo:: using symbol tables and Sub::Name w/out package name)');
69 ok($Foo->has_method('blah'), '... Foo->has_method(blah) (defined in main:: using fully qualified package name)');
70 ok($Foo->has_method('bling'), '... Foo->has_method(bling) (defined in main:: using symbol tables (no Sub::Name))');
71 ok($Foo->has_method('bang'), '... Foo->has_method(bang) (defined in main:: using symbol tables and Sub::Name)');
72 ok($Foo->has_method('evaled_foo'), '... Foo->has_method(evaled_foo) (evaled in main::)');
74 ok(!$Foo->has_method('blessed'), '... !Foo->has_method(blessed) (imported into Foo)');
75 ok(!$Foo->has_method('boom'), '... !Foo->has_method(boom) (defined in main:: using symbol tables and Sub::Name w/out package name)');
77 ok(!$Foo->has_method('not_a_real_method'), '... !Foo->has_method(not_a_real_method) (does not exist)');
78 is($Foo->get_method('not_a_real_method'), undef, '... Foo->get_method(not_a_real_method) == undef');
81 [ sort $Foo->get_method_list ],
82 [ qw(FOO_CONSTANT bang bar baz blah bling evaled_foo floob foo) ],
83 '... got the right method list for Foo');
86 [ sort { $a->{name} cmp $b->{name} } $Foo->compute_all_applicable_methods() ],
92 code => $Foo->get_method($_)
106 '... got the right list of applicable methods for Foo');
108 is($Foo->remove_method('foo'), $foo, '... removed the foo method');
109 ok(!$Foo->has_method('foo'), '... !Foo->has_method(foo) we just removed it');
110 dies_ok { Foo->foo } '... cannot call Foo->foo because it is not there';
113 [ sort $Foo->get_method_list ],
114 [ qw(FOO_CONSTANT bang bar baz blah bling evaled_foo floob) ],
115 '... got the right method list for Foo');
117 ok($Foo->remove_method('FOO_CONSTANT'), '... removed the FOO_CONSTANT method');
118 ok(!$Foo->has_method('FOO_CONSTANT'), '... !Foo->has_method(FOO_CONSTANT) we just removed it');
119 dies_ok { Foo->FOO_CONSTANT } '... cannot call Foo->FOO_CONSTANT because it is not there';
122 [ sort $Foo->get_method_list ],
123 [ qw(bang bar baz blah bling evaled_foo floob) ],
124 '... got the right method list for Foo');
126 # ... test our class creator
128 my $Bar = Class::MOP::Class->create(
130 superclasses => [ 'Foo' ],
132 foo => sub { 'Bar::foo' },
133 bar => sub { 'Bar::bar' },
136 isa_ok($Bar, 'Class::MOP::Class');
138 ok($Bar->has_method('foo'), '... Bar->has_method(foo)');
139 ok($Bar->has_method('bar'), '... Bar->has_method(bar)');
141 is(Bar->foo, 'Bar::foo', '... Bar->foo == Bar::foo');
142 is(Bar->bar, 'Bar::bar', '... Bar->bar == Bar::bar');
145 $Bar->add_method('foo' => sub { 'Bar::foo v2' });
146 } '... overwriting a method is fine';
148 ok($Bar->has_method('foo'), '... Bar-> (still) has_method(foo)');
149 is(Bar->foo, 'Bar::foo v2', '... Bar->foo == "Bar::foo v2"');
152 [ sort $Bar->get_method_list ],
154 '... got the right method list for Bar');
157 [ sort { $a->{name} cmp $b->{name} } $Bar->compute_all_applicable_methods() ],
162 code => $Foo->get_method('bang')
167 code => $Bar->get_method('bar')
173 code => $Foo->get_method($_)
185 code => $Bar->get_method('foo')
188 '... got the right list of applicable methods for Bar');