X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F003_methods.t;h=91399cfe28fa7ad5e39cc107af9b144cbc04d50c;hb=ba38bf08d30369c19a2c25997a0243c0d30be3d5;hp=994347606d480f24148483ad3311bce36d950b45;hpb=de19f1153a5df8765eae928ea430b7acab545554;p=gitmo%2FClass-MOP.git diff --git a/t/003_methods.t b/t/003_methods.t index 9943476..91399cf 100644 --- a/t/003_methods.t +++ b/t/003_methods.t @@ -3,9 +3,11 @@ use strict; use warnings; -use Test::More tests => 52; +use Test::More tests => 64; use Test::Exception; +use Scalar::Util qw/reftype/; + BEGIN { use_ok('Class::MOP'); use_ok('Class::MOP::Class'); @@ -32,6 +34,11 @@ BEGIN { # We hateses the "used only once" warnings { my $temp = \&Foo::baz } + + package OinkyBoinky; + our @ISA = "Foo"; + + sub elk { 'OinkyBoinky::elk' } package main; @@ -57,14 +64,16 @@ lives_ok { $Foo->add_method('foo' => $foo); } '... we added the method successfully'; -isa_ok($foo, 'Class::MOP::Method'); +my $foo_method = $Foo->get_method('foo'); + +isa_ok($foo_method, 'Class::MOP::Method'); -is($foo->name, 'foo', '... got the right name for the method'); -is($foo->package_name, 'Foo', '... got the right package name for the method'); +is($foo_method->name, 'foo', '... got the right name for the method'); +is($foo_method->package_name, 'Foo', '... got the right package name for the method'); ok($Foo->has_method('foo'), '... Foo->has_method(foo) (defined with Sub::Name)'); -is($Foo->get_method('foo'), $foo, '... Foo->get_method(foo) == \&foo'); +is($Foo->get_method('foo')->body, $foo, '... Foo->get_method(foo) == \&foo'); is(Foo->foo(), 'Foo::foo', '... Foo->foo() returns "Foo::foo"'); # now check all our other items ... @@ -78,17 +87,32 @@ ok($Foo->has_method('bling'), '... Foo->has_method(bling) (defined in main:: usi ok($Foo->has_method('bang'), '... Foo->has_method(bang) (defined in main:: using symbol tables and Sub::Name)'); ok($Foo->has_method('evaled_foo'), '... Foo->has_method(evaled_foo) (evaled in main::)'); +my $OinkyBoinky = Class::MOP::Class->initialize('OinkyBoinky'); + +ok($OinkyBoinky->has_method('elk'), "the method 'elk' is defined in OinkyBoinky"); + +ok(!$OinkyBoinky->has_method('bar'), "the method 'bar' is not defined in OinkyBoinky"); + +ok(my $bar = $OinkyBoinky->find_method_by_name('bar'), "but if you look in the inheritence chain then 'bar' does exist"); + +is( reftype($bar->body), "CODE", "the returned value is a code ref" ); + + # calling get_method blessed them all -isa_ok($_, 'Class::MOP::Method') for ( - \&Foo::FOO_CONSTANT, - \&Foo::bar, - \&Foo::baz, - \&Foo::floob, - \&Foo::blah, - \&Foo::bling, - \&Foo::bang, - \&Foo::evaled_foo, - ); +for my $method_name (qw/FOO_CONSTANT + bar + baz + floob + blah + bling + bang + evaled_foo/) { + isa_ok($Foo->get_method($method_name), 'Class::MOP::Method'); + { + no strict 'refs'; + is($Foo->get_method($method_name)->body, \&{'Foo::' . $method_name}, '... body matches CODE ref in package'); + } +} { package Foo::Aliasing; @@ -119,7 +143,7 @@ is_deeply( { name => $_, class => 'Foo', - code => $Foo->get_method($_) + code => $Foo->get_method($_) } } qw( FOO_CONSTANT @@ -135,7 +159,7 @@ is_deeply( ], '... got the right list of applicable methods for Foo'); -is($Foo->remove_method('foo'), $foo, '... removed the foo method'); +is($Foo->remove_method('foo')->body, $foo, '... removed the foo method'); ok(!$Foo->has_method('foo'), '... !Foo->has_method(foo) we just removed it'); dies_ok { Foo->foo } '... cannot call Foo->foo because it is not there'; @@ -156,7 +180,7 @@ is_deeply( # ... test our class creator my $Bar = Class::MOP::Class->create( - 'Bar' => '0.10' => ( + 'Bar' => ( superclasses => [ 'Foo' ], methods => { foo => sub { 'Bar::foo' }, @@ -189,18 +213,18 @@ is_deeply( { name => 'bang', class => 'Foo', - code => $Foo->get_method('bang') + code => $Foo->get_method('bang') }, { name => 'bar', class => 'Bar', - code => $Bar->get_method('bar') + code => $Bar->get_method('bar') }, (map { { name => $_, class => 'Foo', - code => $Foo->get_method($_) + code => $Foo->get_method($_) } } qw( baz @@ -212,12 +236,12 @@ is_deeply( { name => 'foo', class => 'Bar', - code => $Bar->get_method('foo') + code => $Bar->get_method('foo') }, { name => 'meta', class => 'Bar', - code => $Bar->get_method('meta') + code => $Bar->get_method('meta') } ], '... got the right list of applicable methods for Bar');