From: Dave Rolsky Date: Fri, 3 Jul 2009 15:32:22 +0000 (-0500) Subject: These tests all had tabs, so I just ran them through perltidy X-Git-Tag: 0.90~39 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=49ca2e9749fc22662e9b0ad515777c87cc70e15e;p=gitmo%2FClass-MOP.git These tests all had tabs, so I just ran them through perltidy --- diff --git a/t/003_methods.t b/t/003_methods.t index b1c97a7..a176441 100644 --- a/t/003_methods.t +++ b/t/003_methods.t @@ -11,205 +11,246 @@ use Class::MOP; use Class::MOP::Class; use Class::MOP::Method; -{ # This package tries to test &has_method - # as exhaustively as possible. More corner - # cases are welcome :) +{ + # This package tries to test &has_method as exhaustively as + # possible. More corner cases are welcome :) package Foo; - + # import a sub - use Scalar::Util 'blessed'; - + use Scalar::Util 'blessed'; + sub pie; sub cake (); use constant FOO_CONSTANT => 'Foo-CONSTANT'; - + # define a sub in package - sub bar { 'Foo::bar' } + sub bar {'Foo::bar'} *baz = \&bar; - + # create something with the typeglob inside the package - *baaz = sub { 'Foo::baaz' }; + *baaz = sub {'Foo::baaz'}; - { # method named with Sub::Name inside the package scope + { # method named with Sub::Name inside the package scope no strict 'refs'; - *{'Foo::floob'} = Sub::Name::subname 'floob' => sub { '!floob!' }; + *{'Foo::floob'} = Sub::Name::subname 'floob' => sub {'!floob!'}; } # We hateses the "used only once" warnings - { + { my $temp1 = \&Foo::baz; - my $temp2 = \&Foo::baaz; + my $temp2 = \&Foo::baaz; } - + package OinkyBoinky; our @ISA = "Foo"; - - sub elk { 'OinkyBoinky::elk' } + + sub elk {'OinkyBoinky::elk'} package main; - + sub Foo::blah { $_[0]->Foo::baz() } - + { no strict 'refs'; - *{'Foo::bling'} = sub { '$$Bling$$' }; - *{'Foo::bang'} = Sub::Name::subname 'Foo::bang' => sub { '!BANG!' }; - *{'Foo::boom'} = Sub::Name::subname 'boom' => sub { '!BOOM!' }; - - eval "package Foo; sub evaled_foo { 'Foo::evaled_foo' }"; + *{'Foo::bling'} = sub {'$$Bling$$'}; + *{'Foo::bang'} = Sub::Name::subname 'Foo::bang' => sub {'!BANG!'}; + *{'Foo::boom'} = Sub::Name::subname 'boom' => sub {'!BOOM!'}; + + eval "package Foo; sub evaled_foo { 'Foo::evaled_foo' }"; } } my $Foo = Class::MOP::Class->initialize('Foo'); -ok($Foo->has_method('pie'), '... got the method stub pie'); -ok($Foo->has_method('cake'), '... got the constant method stub cake'); +ok( $Foo->has_method('pie'), '... got the method stub pie' ); +ok( $Foo->has_method('cake'), '... got the constant method stub cake' ); -my $foo = sub { 'Foo::foo' }; +my $foo = sub {'Foo::foo'}; -ok(!UNIVERSAL::isa($foo, 'Class::MOP::Method'), '... our method is not yet blessed'); +ok( !UNIVERSAL::isa( $foo, 'Class::MOP::Method' ), + '... our method is not yet blessed' ); lives_ok { - $Foo->add_method('foo' => $foo); -} '... we added the method successfully'; + $Foo->add_method( 'foo' => $foo ); +} +'... we added the method successfully'; my $foo_method = $Foo->get_method('foo'); -isa_ok($foo_method, 'Class::MOP::Method'); +isa_ok( $foo_method, 'Class::MOP::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'); +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)'); +ok( $Foo->has_method('foo'), + '... Foo->has_method(foo) (defined with Sub::Name)' ); -is($Foo->get_method('foo')->body, $foo, '... Foo->get_method(foo) == \&foo'); -is($Foo->get_method('foo')->execute, 'Foo::foo', '... _method_foo->execute returns "Foo::foo"'); -is(Foo->foo(), 'Foo::foo', '... Foo->foo() returns "Foo::foo"'); +is( $Foo->get_method('foo')->body, $foo, + '... Foo->get_method(foo) == \&foo' ); +is( $Foo->get_method('foo')->execute, 'Foo::foo', + '... _method_foo->execute returns "Foo::foo"' ); +is( Foo->foo(), 'Foo::foo', '... Foo->foo() returns "Foo::foo"' ); # now check all our other items ... -ok($Foo->has_method('FOO_CONSTANT'), '... not Foo->has_method(FOO_CONSTANT) (defined w/ use constant)'); -ok(!$Foo->has_method('bling'), '... not Foo->has_method(bling) (defined in main:: using symbol tables (no Sub::Name))'); +ok( $Foo->has_method('FOO_CONSTANT'), + '... not Foo->has_method(FOO_CONSTANT) (defined w/ use constant)' ); +ok( !$Foo->has_method('bling'), + '... not Foo->has_method(bling) (defined in main:: using symbol tables (no Sub::Name))' +); -ok($Foo->has_method('bar'), '... Foo->has_method(bar) (defined in Foo)'); -ok($Foo->has_method('baz'), '... Foo->has_method(baz) (typeglob aliased within Foo)'); -ok($Foo->has_method('baaz'), '... Foo->has_method(baaz) (typeglob aliased within Foo)'); -ok($Foo->has_method('floob'), '... Foo->has_method(floob) (defined in Foo:: using symbol tables and Sub::Name w/out package name)'); -ok($Foo->has_method('blah'), '... Foo->has_method(blah) (defined in main:: using fully qualified package name)'); -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::)'); +ok( $Foo->has_method('bar'), '... Foo->has_method(bar) (defined in Foo)' ); +ok( $Foo->has_method('baz'), + '... Foo->has_method(baz) (typeglob aliased within Foo)' ); +ok( $Foo->has_method('baaz'), + '... Foo->has_method(baaz) (typeglob aliased within Foo)' ); +ok( $Foo->has_method('floob'), + '... Foo->has_method(floob) (defined in Foo:: using symbol tables and Sub::Name w/out package name)' +); +ok( $Foo->has_method('blah'), + '... Foo->has_method(blah) (defined in main:: using fully qualified package name)' +); +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( $OinkyBoinky->has_method('elk'), + "the method 'elk' is defined in OinkyBoinky" ); -ok(my $bar = $OinkyBoinky->find_method_by_name('bar'), "but if you look in the inheritence chain then 'bar' does exist"); +ok( !$OinkyBoinky->has_method('bar'), + "the method 'bar' is not defined in OinkyBoinky" ); -is( reftype($bar->body), "CODE", "the returned value is a code ref" ); +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 -for my $method_name (qw/baaz - bar - baz - floob - blah - bang - evaled_foo - FOO_CONSTANT/) { - isa_ok($Foo->get_method($method_name), 'Class::MOP::Method'); +for my $method_name ( + qw/baaz + bar + baz + floob + blah + bang + evaled_foo + FOO_CONSTANT/ + ) { + 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 for ' . $method_name); + is( $Foo->get_method($method_name)->body, + \&{ 'Foo::' . $method_name }, + '... body matches CODE ref in package for ' . $method_name ); } } -for my $method_name (qw/ - bling - /) { - is(ref($Foo->get_package_symbol('&' . $method_name)), 'CODE', '... got the __ANON__ methods'); +for my $method_name ( + qw/ + bling + / + ) { + is( ref( $Foo->get_package_symbol( '&' . $method_name ) ), 'CODE', + '... got the __ANON__ methods' ); { no strict 'refs'; - is($Foo->get_package_symbol('&' . $method_name), \&{'Foo::' . $method_name}, '... symbol matches CODE ref in package for ' . $method_name); + is( $Foo->get_package_symbol( '&' . $method_name ), + \&{ 'Foo::' . $method_name }, + '... symbol matches CODE ref in package for ' . $method_name ); } } -ok(!$Foo->has_method('blessed'), '... !Foo->has_method(blessed) (imported into Foo)'); -ok(!$Foo->has_method('boom'), '... !Foo->has_method(boom) (defined in main:: using symbol tables and Sub::Name w/out package name)'); +ok( !$Foo->has_method('blessed'), + '... !Foo->has_method(blessed) (imported into Foo)' ); +ok( !$Foo->has_method('boom'), + '... !Foo->has_method(boom) (defined in main:: using symbol tables and Sub::Name w/out package name)' +); -ok(!$Foo->has_method('not_a_real_method'), '... !Foo->has_method(not_a_real_method) (does not exist)'); -is($Foo->get_method('not_a_real_method'), undef, '... Foo->get_method(not_a_real_method) == undef'); +ok( !$Foo->has_method('not_a_real_method'), + '... !Foo->has_method(not_a_real_method) (does not exist)' ); +is( $Foo->get_method('not_a_real_method'), undef, + '... Foo->get_method(not_a_real_method) == undef' ); is_deeply( [ sort $Foo->get_method_list ], - [ qw(FOO_CONSTANT baaz bang bar baz blah cake evaled_foo floob foo pie) ], - '... got the right method list for Foo'); + [qw(FOO_CONSTANT baaz bang bar baz blah cake evaled_foo floob foo pie)], + '... got the right method list for Foo' +); is_deeply( [ sort { $a->name cmp $b->name } $Foo->get_all_methods() ], [ - map { $Foo->get_method($_) } qw( + map { $Foo->get_method($_) } + qw( FOO_CONSTANT - baaz - bang - bar - baz - blah + baaz + bang + bar + baz + blah cake - evaled_foo - floob + evaled_foo + floob foo pie - ) + ) ], - '... got the right list of applicable methods for Foo'); + '... got the right list of applicable methods for Foo' +); -is($Foo->remove_method('foo')->body, $foo, '... removed the foo method'); -ok(!$Foo->has_method('foo'), '... !Foo->has_method(foo) we just removed it'); -ok(!$Foo->get_method_map->{foo}, 'foo is not in the method map'); +is( $Foo->remove_method('foo')->body, $foo, '... removed the foo method' ); +ok( !$Foo->has_method('foo'), + '... !Foo->has_method(foo) we just removed it' ); +ok( !$Foo->get_method_map->{foo}, 'foo is not in the method map' ); dies_ok { Foo->foo } '... cannot call Foo->foo because it is not there'; is_deeply( [ sort $Foo->get_method_list ], - [ qw(FOO_CONSTANT baaz bang bar baz blah cake evaled_foo floob pie) ], - '... got the right method list for Foo'); - + [qw(FOO_CONSTANT baaz bang bar baz blah cake evaled_foo floob pie)], + '... got the right method list for Foo' +); -# ... test our class creator +# ... test our class creator my $Bar = Class::MOP::Class->create( package => 'Bar', - superclasses => [ 'Foo' ], + superclasses => ['Foo'], methods => { - foo => sub { 'Bar::foo' }, - bar => sub { 'Bar::bar' }, + foo => sub {'Bar::foo'}, + bar => sub {'Bar::bar'}, } ); -isa_ok($Bar, 'Class::MOP::Class'); +isa_ok( $Bar, 'Class::MOP::Class' ); -ok($Bar->has_method('foo'), '... Bar->has_method(foo)'); -ok($Bar->has_method('bar'), '... Bar->has_method(bar)'); +ok( $Bar->has_method('foo'), '... Bar->has_method(foo)' ); +ok( $Bar->has_method('bar'), '... Bar->has_method(bar)' ); -is(Bar->foo, 'Bar::foo', '... Bar->foo == Bar::foo'); -is(Bar->bar, 'Bar::bar', '... Bar->bar == Bar::bar'); +is( Bar->foo, 'Bar::foo', '... Bar->foo == Bar::foo' ); +is( Bar->bar, 'Bar::bar', '... Bar->bar == Bar::bar' ); lives_ok { - $Bar->add_method('foo' => sub { 'Bar::foo v2' }); -} '... overwriting a method is fine'; + $Bar->add_method( 'foo' => sub {'Bar::foo v2'} ); +} +'... overwriting a method is fine'; -is_deeply( [ Class::MOP::get_code_info($Bar->get_method('foo')->body) ], [ "Bar", "foo" ], "subname applied to anonymous method" ); +is_deeply( [ Class::MOP::get_code_info( $Bar->get_method('foo')->body ) ], + [ "Bar", "foo" ], "subname applied to anonymous method" ); -ok($Bar->has_method('foo'), '... Bar-> (still) has_method(foo)'); -is(Bar->foo, 'Bar::foo v2', '... Bar->foo == "Bar::foo v2"'); +ok( $Bar->has_method('foo'), '... Bar-> (still) has_method(foo)' ); +is( Bar->foo, 'Bar::foo v2', '... Bar->foo == "Bar::foo v2"' ); is_deeply( [ sort $Bar->get_method_list ], - [ qw(bar foo meta) ], - '... got the right method list for Bar'); - + [qw(bar foo meta)], + '... got the right method list for Bar' +); + is_deeply( [ sort { $a->name cmp $b->name } $Bar->get_all_methods() ], [ @@ -217,18 +258,22 @@ is_deeply( $Foo->get_method('baaz'), $Foo->get_method('bang'), $Bar->get_method('bar'), - (map { $Foo->get_method($_) } qw( - baz - blah - cake - evaled_foo - floob - )), + ( + map { $Foo->get_method($_) } + qw( + baz + blah + cake + evaled_foo + floob + ) + ), $Bar->get_method('foo'), $Bar->get_method('meta'), $Foo->get_method('pie'), ], - '... got the right list of applicable methods for Bar'); + '... got the right list of applicable methods for Bar' +); my $method = Class::MOP::Method->wrap( name => 'objecty', @@ -240,11 +285,12 @@ Bar->meta->add_method( $method->name, $method ); my $new_method = Bar->meta->get_method('objecty'); -isnt( $method, $new_method, 'add_method clones method objects as they are added' ); -is( $new_method->original_method, $method, '... the cloned method has the correct original method' ); +isnt( $method, $new_method, + 'add_method clones method objects as they are added' ); +is( $new_method->original_method, $method, + '... the cloned method has the correct original method' ); { - package CustomAccessor; use Class::MOP; @@ -282,6 +328,8 @@ is( $new_method->original_method, $method, '... the cloned method has the correc $o->foo($str); - is( $o->{custom_store}, $str, - 'Custom glob-assignment-created accessor is still method modifier is added' ); + is( + $o->{custom_store}, $str, + 'Custom glob-assignment-created accessor is still method modifier is added' + ); } diff --git a/t/030_method.t b/t/030_method.t index b968deb..e0dbe62 100644 --- a/t/030_method.t +++ b/t/030_method.t @@ -7,96 +7,133 @@ use Test::Exception; use Class::MOP; use Class::MOP::Method; - my $method = Class::MOP::Method->wrap( - sub { 1 }, + sub {1}, package_name => 'main', name => '__ANON__', ); -is($method->meta, Class::MOP::Method->meta, '... instance and class both lead to the same meta'); - -is($method->package_name, 'main', '... our package is main::'); -is($method->name, '__ANON__', '... our sub name is __ANON__'); -is($method->fully_qualified_name, 'main::__ANON__', '... our subs full name is main::__ANON__'); -is($method->original_method, undef, '... no original_method '); -is($method->original_package_name, 'main', '... the original_package_name is the same as package_name'); -is($method->original_name, '__ANON__', '... the original_name is the same as name'); -is($method->original_fully_qualified_name, 'main::__ANON__', '... the original_fully_qualified_name is the same as fully_qualified_name'); - -dies_ok { Class::MOP::Method->wrap } q{... can't call wrap() without some code}; -dies_ok { Class::MOP::Method->wrap([]) } q{... can't call wrap() without some code}; -dies_ok { Class::MOP::Method->wrap(bless {} => 'Fail') } q{... can't call wrap() without some code}; +is( $method->meta, Class::MOP::Method->meta, + '... instance and class both lead to the same meta' ); + +is( $method->package_name, 'main', '... our package is main::' ); +is( $method->name, '__ANON__', '... our sub name is __ANON__' ); +is( $method->fully_qualified_name, 'main::__ANON__', + '... our subs full name is main::__ANON__' ); +is( $method->original_method, undef, '... no original_method ' ); +is( $method->original_package_name, 'main', + '... the original_package_name is the same as package_name' ); +is( $method->original_name, '__ANON__', + '... the original_name is the same as name' ); +is( $method->original_fully_qualified_name, 'main::__ANON__', + '... the original_fully_qualified_name is the same as fully_qualified_name' +); -dies_ok { Class::MOP::Method->name } q{... can't call name() as a class method}; -dies_ok { Class::MOP::Method->body } q{... can't call body() as a class method}; -dies_ok { Class::MOP::Method->package_name } q{... can't call package_name() as a class method}; -dies_ok { Class::MOP::Method->fully_qualified_name } q{... can't call fully_qualified_name() as a class method}; +dies_ok { Class::MOP::Method->wrap } +q{... can't call wrap() without some code}; +dies_ok { Class::MOP::Method->wrap( [] ) } +q{... can't call wrap() without some code}; +dies_ok { Class::MOP::Method->wrap( bless {} => 'Fail' ) } +q{... can't call wrap() without some code}; + +dies_ok { Class::MOP::Method->name } +q{... can't call name() as a class method}; +dies_ok { Class::MOP::Method->body } +q{... can't call body() as a class method}; +dies_ok { Class::MOP::Method->package_name } +q{... can't call package_name() as a class method}; +dies_ok { Class::MOP::Method->fully_qualified_name } +q{... can't call fully_qualified_name() as a class method}; my $meta = Class::MOP::Method->meta; -isa_ok($meta, 'Class::MOP::Class'); +isa_ok( $meta, 'Class::MOP::Class' ); -foreach my $method_name (qw( +foreach my $method_name ( + qw( wrap - package_name - name - )) { - ok($meta->has_method($method_name), '... Class::MOP::Method->has_method(' . $method_name . ')'); - my $method = $meta->get_method($method_name); - is($method->package_name, 'Class::MOP::Method', '... our package is Class::MOP::Method'); - is($method->name, $method_name, '... our sub name is "' . $method_name . '"'); + package_name + name + ) + ) { + ok( $meta->has_method($method_name), + '... Class::MOP::Method->has_method(' . $method_name . ')' ); + my $method = $meta->get_method($method_name); + is( $method->package_name, 'Class::MOP::Method', + '... our package is Class::MOP::Method' ); + is( $method->name, $method_name, + '... our sub name is "' . $method_name . '"' ); } dies_ok { - Class::MOP::Method->wrap() -} '... bad args for &wrap'; + Class::MOP::Method->wrap(); +} +'... bad args for &wrap'; dies_ok { - Class::MOP::Method->wrap('Fail') -} '... bad args for &wrap'; + Class::MOP::Method->wrap('Fail'); +} +'... bad args for &wrap'; dies_ok { - Class::MOP::Method->wrap([]) -} '... bad args for &wrap'; + Class::MOP::Method->wrap( [] ); +} +'... bad args for &wrap'; dies_ok { - Class::MOP::Method->wrap(sub { 'FAIL' }) -} '... bad args for &wrap'; + Class::MOP::Method->wrap( sub {'FAIL'} ); +} +'... bad args for &wrap'; dies_ok { - Class::MOP::Method->wrap(sub { 'FAIL' }, package_name => 'main') -} '... bad args for &wrap'; + Class::MOP::Method->wrap( sub {'FAIL'}, package_name => 'main' ); +} +'... bad args for &wrap'; dies_ok { - Class::MOP::Method->wrap(sub { 'FAIL' }, name => '__ANON__') -} '... bad args for &wrap'; + Class::MOP::Method->wrap( sub {'FAIL'}, name => '__ANON__' ); +} +'... bad args for &wrap'; lives_ok { - Class::MOP::Method->wrap(bless(sub { 'FAIL' }, "Foo"), name => '__ANON__', package_name => 'Foo::Bar') -} '... blessed coderef to &wrap'; + Class::MOP::Method->wrap( bless( sub {'FAIL'}, "Foo" ), + name => '__ANON__', package_name => 'Foo::Bar' ); +} +'... blessed coderef to &wrap'; my $clone = $method->clone( package_name => 'NewPackage', name => 'new_name', ); -isa_ok($clone, 'Class::MOP::Method'); -is($clone->package_name, 'NewPackage', '... cloned method has new package name'); -is($clone->name, 'new_name', '... cloned method has new sub name'); -is($clone->fully_qualified_name, 'NewPackage::new_name', '... cloned method has new fq name'); -is($clone->original_method, $method, '... cloned method has correct original_method'); -is($clone->original_package_name, 'main', '... cloned method has correct original_package_name'); -is($clone->original_name, '__ANON__', '... cloned method has correct original_name'); -is($clone->original_fully_qualified_name, 'main::__ANON__', '... cloned method has correct original_fully_qualified_name'); +isa_ok( $clone, 'Class::MOP::Method' ); +is( $clone->package_name, 'NewPackage', + '... cloned method has new package name' ); +is( $clone->name, 'new_name', '... cloned method has new sub name' ); +is( $clone->fully_qualified_name, 'NewPackage::new_name', + '... cloned method has new fq name' ); +is( $clone->original_method, $method, + '... cloned method has correct original_method' ); +is( $clone->original_package_name, 'main', + '... cloned method has correct original_package_name' ); +is( $clone->original_name, '__ANON__', + '... cloned method has correct original_name' ); +is( $clone->original_fully_qualified_name, 'main::__ANON__', + '... cloned method has correct original_fully_qualified_name' ); my $clone2 = $clone->clone( package_name => 'NewerPackage', name => 'newer_name', ); -is($clone2->package_name, 'NewerPackage', '... clone of clone has new package name'); -is($clone2->name, 'newer_name', '... clone of clone has new sub name'); -is($clone2->fully_qualified_name, 'NewerPackage::newer_name', '... clone of clone new fq name'); -is($clone2->original_method, $clone, '... cloned method has correct original_method'); -is($clone2->original_package_name, 'main', '... original_package_name follows clone chain'); -is($clone2->original_name, '__ANON__', '... original_name follows clone chain'); -is($clone2->original_fully_qualified_name, 'main::__ANON__', '... original_fully_qualified_name follows clone chain'); +is( $clone2->package_name, 'NewerPackage', + '... clone of clone has new package name' ); +is( $clone2->name, 'newer_name', '... clone of clone has new sub name' ); +is( $clone2->fully_qualified_name, 'NewerPackage::newer_name', + '... clone of clone new fq name' ); +is( $clone2->original_method, $clone, + '... cloned method has correct original_method' ); +is( $clone2->original_package_name, 'main', + '... original_package_name follows clone chain' ); +is( $clone2->original_name, '__ANON__', + '... original_name follows clone chain' ); +is( $clone2->original_fully_qualified_name, 'main::__ANON__', + '... original_fully_qualified_name follows clone chain' ); diff --git a/t/300_random_eval_bug.t b/t/300_random_eval_bug.t index 112ae87..497a698 100644 --- a/t/300_random_eval_bug.t +++ b/t/300_random_eval_bug.t @@ -22,26 +22,27 @@ Moral of the story: use strict; use warnings; use metaclass; - + sub new { my ($class) = @_; return bless {} => $class; - } - + } + sub employees { die "This didnt work"; } - + sub DESTROY { - my $self = shift; - foreach my $method ($self->meta->find_all_methods_by_name('DEMOLISH')) { - $method->{code}->($self); - } + my $self = shift; + foreach + my $method ( $self->meta->find_all_methods_by_name('DEMOLISH') ) { + $method->{code}->($self); + } } } -eval { - my $c = Company->new(); +eval { + my $c = Company->new(); $c->employees(); -}; -ok($@, '... we die correctly with bad args'); +}; +ok( $@, '... we die correctly with bad args' ); diff --git a/t/302_modify_parent_method.t b/t/302_modify_parent_method.t index cc57cdd..734bcd4 100644 --- a/t/302_modify_parent_method.t +++ b/t/302_modify_parent_method.t @@ -19,65 +19,82 @@ my @calls; sub method { push @calls, 'Parent::method' } - package Child; + package Child; - use strict; - use warnings; + use strict; + use warnings; use metaclass; - use base 'Parent'; + use base 'Parent'; - Child->meta->add_around_method_modifier('method' => sub { - my $orig = shift; - push @calls, 'before Child::method'; - $orig->(@_); - push @calls, 'after Child::method'; - }); + Child->meta->add_around_method_modifier( + 'method' => sub { + my $orig = shift; + push @calls, 'before Child::method'; + $orig->(@_); + push @calls, 'after Child::method'; + } + ); } Parent->method; -is_deeply([splice @calls], [ - 'Parent::method', -]); +is_deeply( + [ splice @calls ], + [ + 'Parent::method', + ] +); Child->method; -is_deeply([splice @calls], [ - 'before Child::method', - 'Parent::method', - 'after Child::method', -]); +is_deeply( + [ splice @calls ], + [ + 'before Child::method', + 'Parent::method', + 'after Child::method', + ] +); { package Parent; - Parent->meta->add_around_method_modifier('method' => sub { - my $orig = shift; - push @calls, 'before Parent::method'; - $orig->(@_); - push @calls, 'after Parent::method'; - }); + Parent->meta->add_around_method_modifier( + 'method' => sub { + my $orig = shift; + push @calls, 'before Parent::method'; + $orig->(@_); + push @calls, 'after Parent::method'; + } + ); } Parent->method; -is_deeply([splice @calls], [ - 'before Parent::method', - 'Parent::method', - 'after Parent::method', -]); +is_deeply( + [ splice @calls ], + [ + 'before Parent::method', + 'Parent::method', + 'after Parent::method', + ] +); Child->method; TODO: { local $TODO = "pending fix"; - is_deeply([splice @calls], [ - 'before Child::method', - 'before Parent::method', - 'Parent::method', - 'after Parent::method', - 'after Child::method', - ], "cache is correctly invalidated when the parent method is wrapped"); + is_deeply( + [ splice @calls ], + [ + 'before Child::method', + 'before Parent::method', + 'Parent::method', + 'after Parent::method', + 'after Child::method', + ], + "cache is correctly invalidated when the parent method is wrapped" + ); }