6 use Test::More no_plan => 1;
12 use_ok('Class::MOP::Class');
15 { # This package tries to test &has_method
16 # as exhaustively as possible. More corner
17 # cases are welcome :)
21 use Scalar::Util 'blessed';
23 use constant FOO_CONSTANT => 'Foo-CONSTANT';
25 # define a sub in package
26 sub bar { 'Foo::bar' }
29 { # method named with Sub::Name inside the package scope
31 *{'Foo::floob'} = Sub::Name::subname 'floob' => sub { '!floob!' };
34 # We hateses the "used only once" warnings
35 { my $temp = \&Foo::baz }
39 sub Foo::blah { $_[0]->Foo::baz() }
43 *{'Foo::bling'} = sub { '$$Bling$$' };
44 *{'Foo::bang'} = Sub::Name::subname 'Foo::bang' => sub { '!BANG!' };
45 *{'Foo::boom'} = Sub::Name::subname 'boom' => sub { '!BOOM!' };
47 eval "package Foo; sub evaled_foo { 'Foo::evaled_foo' }";
51 my $Foo = Class::MOP::Class->initialize('Foo');
53 my $foo = sub { 'Foo::foo' };
56 $Foo->add_method('foo' => $foo);
57 } '... we added the method successfully';
59 ok($Foo->has_method('foo'), '... Foo->has_method(foo) (defined with Sub::Name)');
61 is($Foo->get_method('foo'), $foo, '... Foo->get_method(foo) == \&foo');
62 is(Foo->foo(), 'Foo::foo', '... Foo->foo() returns "Foo::foo"');
64 # now check all our other items ...
66 ok($Foo->has_method('FOO_CONSTANT'), '... Foo->has_method(FOO_CONSTANT) (defined w/ use constant)');
67 ok($Foo->has_method('bar'), '... Foo->has_method(bar) (defined in Foo)');
68 ok($Foo->has_method('baz'), '... Foo->has_method(baz) (typeglob aliased within Foo)');
69 ok($Foo->has_method('floob'), '... Foo->has_method(floob) (defined in Foo:: using symbol tables and Sub::Name w/out package name)');
70 ok($Foo->has_method('blah'), '... Foo->has_method(blah) (defined in main:: using fully qualified package name)');
71 ok($Foo->has_method('bling'), '... Foo->has_method(bling) (defined in main:: using symbol tables (no Sub::Name))');
72 ok($Foo->has_method('bang'), '... Foo->has_method(bang) (defined in main:: using symbol tables and Sub::Name)');
73 ok($Foo->has_method('evaled_foo'), '... Foo->has_method(evaled_foo) (evaled in main::)');
75 ok(!$Foo->has_method('blessed'), '... !Foo->has_method(blessed) (imported into Foo)');
76 ok(!$Foo->has_method('boom'), '... !Foo->has_method(boom) (defined in main:: using symbol tables and Sub::Name w/out package name)');
78 ok(!$Foo->has_method('not_a_real_method'), '... !Foo->has_method(not_a_real_method) (does not exist)');
79 is($Foo->get_method('not_a_real_method'), undef, '... Foo->get_method(not_a_real_method) == undef');
82 [ sort $Foo->get_method_list ],
83 [ qw(FOO_CONSTANT bang bar baz blah bling evaled_foo floob foo) ],
84 '... got the right method list for Foo');
86 is($Foo->remove_method('foo'), $foo, '... removed the foo method');
87 ok(!$Foo->has_method('foo'), '... !Foo->has_method(foo) we just removed it');
88 dies_ok { Foo->foo } '... cannot call Foo->foo because it is not there';
91 [ sort $Foo->get_method_list ],
92 [ qw(FOO_CONSTANT bang bar baz blah bling evaled_foo floob) ],
93 '... got the right method list for Foo');
95 ok($Foo->remove_method('FOO_CONSTANT'), '... removed the FOO_CONSTANT method');
96 ok(!$Foo->has_method('FOO_CONSTANT'), '... !Foo->has_method(FOO_CONSTANT) we just removed it');
97 dies_ok { Foo->FOO_CONSTANT } '... cannot call Foo->FOO_CONSTANT because it is not there';
100 [ sort $Foo->get_method_list ],
101 [ qw(bang bar baz blah bling evaled_foo floob) ],
102 '... got the right method list for Foo');
104 # ... test our class creator
106 my $Bar = Class::MOP::Class->create(
108 superclasses => [ 'Foo' ],
110 foo => sub { 'Bar::foo' },
111 bar => sub { 'Bar::bar' },
114 isa_ok($Bar, 'Class::MOP::Class');
116 ok($Bar->has_method('foo'), '... Bar->has_method(foo)');
117 ok($Bar->has_method('bar'), '... Bar->has_method(bar)');
119 is(Bar->foo, 'Bar::foo', '... Bar->foo == Bar::foo');
120 is(Bar->bar, 'Bar::bar', '... Bar->bar == Bar::bar');
123 $Bar->add_method('foo' => sub { 'Bar::foo v2' });
124 } '... overwriting a method is fine';
126 ok($Bar->has_method('foo'), '... Bar-> (still) has_method(foo)');
127 is(Bar->foo, 'Bar::foo v2', '... Bar->foo == "Bar::foo v2"');
130 [ sort $Bar->get_method_list ],
132 '... got the right method list for Bar');