From: Florian Ragwitz Date: Thu, 10 Dec 2009 21:15:59 +0000 (+0100) Subject: Convert all tests to done_testing. X-Git-Tag: 0.96~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=86a4d8730cfe673db674c692f7703632b700c7c9;p=gitmo%2FClass-MOP.git Convert all tests to done_testing. --- diff --git a/t/000_load.t b/t/000_load.t index 2507c47..3aa0fcd 100644 --- a/t/000_load.t +++ b/t/000_load.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 50; +use Test::More; BEGIN { use_ok('Class::MOP'); @@ -130,3 +130,5 @@ is( ); isa_ok(Class::MOP::Class->meta, 'Class::MOP::Class'); + +done_testing; diff --git a/t/001_basic.t b/t/001_basic.t index 1e9fca0..f45712d 100644 --- a/t/001_basic.t +++ b/t/001_basic.t @@ -1,20 +1,20 @@ use strict; use warnings; -use Test::More tests => 23; +use Test::More; use Test::Exception; use Class::MOP; use Class::MOP::Class; -{ +{ package Foo; use metaclass; our $VERSION = '0.01'; - + package Bar; our @ISA = ('Foo'); - + our $AUTHORITY = 'cpan:JRANDOM'; } @@ -44,15 +44,15 @@ $Foo->superclasses('UNIVERSAL'); is_deeply([$Foo->superclasses], ['UNIVERSAL'], '... Foo->superclasses == (UNIVERSAL) now'); is_deeply( - [ $Foo->class_precedence_list ], - [ 'Foo', 'UNIVERSAL' ], + [ $Foo->class_precedence_list ], + [ 'Foo', 'UNIVERSAL' ], '... Foo->class_precedence_list == (Foo, UNIVERSAL)'); is_deeply( - [ $Bar->class_precedence_list ], - [ 'Bar', 'Foo', 'UNIVERSAL' ], + [ $Bar->class_precedence_list ], + [ 'Bar', 'Foo', 'UNIVERSAL' ], '... Bar->class_precedence_list == (Bar, Foo, UNIVERSAL)'); - + # create a class using Class::MOP::Class ... my $Baz = Class::MOP::Class->create( @@ -73,7 +73,8 @@ is($Baz->identifier, 'Baz-0.10-cpan:YOMAMA', '... Baz->identifier == Baz-0.10-cp is_deeply([$Baz->superclasses], ['Bar'], '... Baz->superclasses == (Bar)'); is_deeply( - [ $Baz->class_precedence_list ], - [ 'Baz', 'Bar', 'Foo', 'UNIVERSAL' ], + [ $Baz->class_precedence_list ], + [ 'Baz', 'Bar', 'Foo', 'UNIVERSAL' ], '... Baz->class_precedence_list == (Baz, Bar, Foo, UNIVERSAL)'); +done_testing; diff --git a/t/002_class_precedence_list.t b/t/002_class_precedence_list.t index 25bfafc..7bc1fd4 100644 --- a/t/002_class_precedence_list.t +++ b/t/002_class_precedence_list.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 6; +use Test::More; use Class::MOP; use Class::MOP::Class; @@ -22,19 +22,19 @@ B C package My::B; our @ISA = ('My::A'); package My::C; - our @ISA = ('My::A'); - package My::D; - our @ISA = ('My::B', 'My::C'); + our @ISA = ('My::A'); + package My::D; + our @ISA = ('My::B', 'My::C'); } is_deeply( - [ My::D->meta->class_precedence_list ], - [ 'My::D', 'My::B', 'My::A', 'My::C', 'My::A' ], + [ My::D->meta->class_precedence_list ], + [ 'My::D', 'My::B', 'My::A', 'My::C', 'My::A' ], '... My::D->meta->class_precedence_list == (D B A C A)'); is_deeply( - [ My::D->meta->linearized_isa ], - [ 'My::D', 'My::B', 'My::A', 'My::C' ], + [ My::D->meta->linearized_isa ], + [ 'My::D', 'My::B', 'My::A', 'My::C' ], '... My::D->meta->linearized_isa == (D B A C)'); =pod @@ -53,14 +53,14 @@ is_deeply( eval { { package My::2::A; - use metaclass; + use metaclass; our @ISA = ('My::2::C'); - + package My::2::B; our @ISA = ('My::2::A'); - + package My::2::C; - our @ISA = ('My::2::B'); + our @ISA = ('My::2::B'); } My::2::B->meta->class_precedence_list @@ -80,23 +80,23 @@ ok($@, '... recursive inheritance breaks correctly :)'); { package My::3::A; - use metaclass; + use metaclass; package My::3::B; our @ISA = ('My::3::A'); package My::3::C; - our @ISA = ('My::3::A', 'My::3::B'); - package My::3::D; - our @ISA = ('My::3::B', 'My::3::C'); + our @ISA = ('My::3::A', 'My::3::B'); + package My::3::D; + our @ISA = ('My::3::B', 'My::3::C'); } is_deeply( - [ My::3::D->meta->class_precedence_list ], - [ 'My::3::D', 'My::3::B', 'My::3::A', 'My::3::C', 'My::3::A', 'My::3::B', 'My::3::A' ], + [ My::3::D->meta->class_precedence_list ], + [ 'My::3::D', 'My::3::B', 'My::3::A', 'My::3::C', 'My::3::A', 'My::3::B', 'My::3::A' ], '... My::3::D->meta->class_precedence_list == (D B A C A B A)'); is_deeply( - [ My::3::D->meta->linearized_isa ], - [ 'My::3::D', 'My::3::B', 'My::3::A', 'My::3::C' ], + [ My::3::D->meta->linearized_isa ], + [ 'My::3::D', 'My::3::B', 'My::3::A', 'My::3::C' ], '... My::3::D->meta->linearized_isa == (D B A C B)'); =pod @@ -111,49 +111,50 @@ my @CLASS_PRECEDENCE_LIST; { package Foo; - use metaclass; - - sub CPL { push @CLASS_PRECEDENCE_LIST => 'Foo' } - + use metaclass; + + sub CPL { push @CLASS_PRECEDENCE_LIST => 'Foo' } + package Bar; our @ISA = ('Foo'); - - sub CPL { + + sub CPL { push @CLASS_PRECEDENCE_LIST => 'Bar'; $_[0]->SUPER::CPL(); - } - + } + package Baz; - use metaclass; + use metaclass; our @ISA = ('Bar'); - - sub CPL { + + sub CPL { push @CLASS_PRECEDENCE_LIST => 'Baz'; $_[0]->SUPER::CPL(); - } - + } + package Foo::Bar; our @ISA = ('Baz'); - - sub CPL { + + sub CPL { push @CLASS_PRECEDENCE_LIST => 'Foo::Bar'; $_[0]->SUPER::CPL(); - } - + } + package Foo::Bar::Baz; our @ISA = ('Foo::Bar'); - - sub CPL { + + sub CPL { push @CLASS_PRECEDENCE_LIST => 'Foo::Bar::Baz'; $_[0]->SUPER::CPL(); - } + } } Foo::Bar::Baz->CPL(); is_deeply( - [ Foo::Bar::Baz->meta->class_precedence_list ], - [ @CLASS_PRECEDENCE_LIST ], + [ Foo::Bar::Baz->meta->class_precedence_list ], + [ @CLASS_PRECEDENCE_LIST ], '... Foo::Bar::Baz->meta->class_precedence_list == @CLASS_PRECEDENCE_LIST'); +done_testing; diff --git a/t/003_methods.t b/t/003_methods.t index ddbd7ec..547ab5f 100644 --- a/t/003_methods.t +++ b/t/003_methods.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 69; +use Test::More; use Test::Exception; use Scalar::Util qw/reftype/; @@ -351,3 +351,5 @@ is( $new_method->original_method, $method, ok( $method, 'Got the foo method back' ); } } + +done_testing; diff --git a/t/004_advanced_methods.t b/t/004_advanced_methods.t index f598382..b67cdac 100644 --- a/t/004_advanced_methods.t +++ b/t/004_advanced_methods.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 11; +use Test::More; use Test::Exception; use Class::MOP; @@ -9,7 +9,7 @@ use Class::MOP::Class; =pod -The following class hierarhcy is very contrived +The following class hierarhcy is very contrived and totally horrid (it won't work under C3 even), but it tests a number of aspect of this module. @@ -19,54 +19,54 @@ A more real-world example would be a nice addition :) { package Foo; - - sub BUILD { 'Foo::BUILD' } + + sub BUILD { 'Foo::BUILD' } sub foo { 'Foo::foo' } - + package Bar; our @ISA = ('Foo'); - - sub BUILD { 'Bar::BUILD' } - sub bar { 'Bar::bar' } - + + sub BUILD { 'Bar::BUILD' } + sub bar { 'Bar::bar' } + package Baz; our @ISA = ('Bar'); - + sub baz { 'Baz::baz' } - sub foo { 'Baz::foo' } - + sub foo { 'Baz::foo' } + package Foo::Bar; our @ISA = ('Foo', 'Bar'); - - sub BUILD { 'Foo::Bar::BUILD' } - sub foobar { 'Foo::Bar::foobar' } - + + sub BUILD { 'Foo::Bar::BUILD' } + sub foobar { 'Foo::Bar::foobar' } + package Foo::Bar::Baz; our @ISA = ('Foo', 'Bar', 'Baz'); - - sub BUILD { 'Foo::Bar::Baz::BUILD' } - sub bar { 'Foo::Bar::Baz::bar' } - sub foobarbaz { 'Foo::Bar::Baz::foobarbaz' } + + sub BUILD { 'Foo::Bar::Baz::BUILD' } + sub bar { 'Foo::Bar::Baz::bar' } + sub foobarbaz { 'Foo::Bar::Baz::foobarbaz' } } -ok(!defined(Class::MOP::Class->initialize('Foo')->find_next_method_by_name('BUILD')), +ok(!defined(Class::MOP::Class->initialize('Foo')->find_next_method_by_name('BUILD')), '... Foo::BUILD has not next method'); -is(Class::MOP::Class->initialize('Bar')->find_next_method_by_name('BUILD'), - Class::MOP::Class->initialize('Foo')->get_method('BUILD'), +is(Class::MOP::Class->initialize('Bar')->find_next_method_by_name('BUILD'), + Class::MOP::Class->initialize('Foo')->get_method('BUILD'), '... Bar::BUILD does have a next method'); - -is(Class::MOP::Class->initialize('Baz')->find_next_method_by_name('BUILD'), - Class::MOP::Class->initialize('Bar')->get_method('BUILD'), - '... Baz->BUILD does have a next method'); - -is(Class::MOP::Class->initialize('Foo::Bar')->find_next_method_by_name('BUILD'), - Class::MOP::Class->initialize('Foo')->get_method('BUILD'), - '... Foo::Bar->BUILD does have a next method'); - -is(Class::MOP::Class->initialize('Foo::Bar::Baz')->find_next_method_by_name('BUILD'), - Class::MOP::Class->initialize('Foo')->get_method('BUILD'), - '... Foo::Bar::Baz->BUILD does have a next method'); + +is(Class::MOP::Class->initialize('Baz')->find_next_method_by_name('BUILD'), + Class::MOP::Class->initialize('Bar')->get_method('BUILD'), + '... Baz->BUILD does have a next method'); + +is(Class::MOP::Class->initialize('Foo::Bar')->find_next_method_by_name('BUILD'), + Class::MOP::Class->initialize('Foo')->get_method('BUILD'), + '... Foo::Bar->BUILD does have a next method'); + +is(Class::MOP::Class->initialize('Foo::Bar::Baz')->find_next_method_by_name('BUILD'), + Class::MOP::Class->initialize('Foo')->get_method('BUILD'), + '... Foo::Bar::Baz->BUILD does have a next method'); is_deeply( [ sort { $a->{name} cmp $b->{name} } Class::MOP::Class->initialize('Foo')->get_all_methods() ], @@ -75,7 +75,7 @@ is_deeply( Class::MOP::Class->initialize('Foo')->get_method('foo'), ], '... got the right list of applicable methods for Foo'); - + is_deeply( [ sort { $a->{name} cmp $b->{name} } Class::MOP::Class->initialize('Bar')->get_all_methods() ], [ @@ -84,11 +84,11 @@ is_deeply( Class::MOP::Class->initialize('Foo')->get_method('foo'), ], '... got the right list of applicable methods for Bar'); - + is_deeply( [ sort { $a->{name} cmp $b->{name} } Class::MOP::Class->initialize('Baz')->get_all_methods() ], - [ + [ Class::MOP::Class->initialize('Bar')->get_method('BUILD'), Class::MOP::Class->initialize('Bar')->get_method('bar'), Class::MOP::Class->initialize('Baz')->get_method('baz'), @@ -115,12 +115,12 @@ is_deeply( name => 'BUILD', class => 'Foo::Bar', code => Class::MOP::Class->initialize('Foo::Bar')->get_method('BUILD') - }, + }, { name => 'BUILD', class => 'Foo', code => Class::MOP::Class->initialize('Foo')->get_method('BUILD') - }, + }, { name => 'BUILD', class => 'Bar', @@ -136,16 +136,18 @@ is_deeply( name => 'BUILD', class => 'Foo::Bar::Baz', code => Class::MOP::Class->initialize('Foo::Bar::Baz')->get_method('BUILD') - }, + }, { name => 'BUILD', class => 'Foo', code => Class::MOP::Class->initialize('Foo')->get_method('BUILD') - }, + }, { name => 'BUILD', class => 'Bar', - code => Class::MOP::Class->initialize('Bar')->get_method('BUILD') - }, + code => Class::MOP::Class->initialize('Bar')->get_method('BUILD') + }, ], '... got the right list of BUILD methods for Foo::Bar::Baz'); + +done_testing; diff --git a/t/005_attributes.t b/t/005_attributes.t index b7a545b..fa10b41 100644 --- a/t/005_attributes.t +++ b/t/005_attributes.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 90; +use Test::More; use Test::Exception; use Class::MOP; @@ -258,3 +258,5 @@ for(1 .. 2){ Buzz->meta->make_immutable(); } + +done_testing; diff --git a/t/006_new_and_clone_metaclasses.t b/t/006_new_and_clone_metaclasses.t index 9dae02f..6c2a21d 100644 --- a/t/006_new_and_clone_metaclasses.t +++ b/t/006_new_and_clone_metaclasses.t @@ -4,7 +4,7 @@ use warnings; use FindBin; use File::Spec::Functions; -use Test::More tests => 35; +use Test::More; use Test::Exception; use Class::MOP; @@ -124,3 +124,4 @@ is($attr->associated_class, $attr_clone->associated_class, '... we successfully did not clone our associated metaclass'); +done_testing; diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t index fd3888f..067a264 100644 --- a/t/010_self_introspection.t +++ b/t/010_self_introspection.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 306; +use Test::More; use Test::Exception; use Class::MOP; @@ -60,7 +60,7 @@ my @class_mop_class_methods = qw( is_pristine initialize create - + update_package_cache_flag reset_package_cache_flag @@ -341,3 +341,4 @@ is($class_mop_class_meta->attribute_metaclass, 'Class::MOP::Attribute', '... got is($class_mop_class_meta->method_metaclass, 'Class::MOP::Method', '... got the right value for method_metaclass'); is($class_mop_class_meta->instance_metaclass, 'Class::MOP::Instance', '... got the right value for instance_metaclass'); +done_testing; diff --git a/t/011_create_class.t b/t/011_create_class.t index a0f6fe3..2267b5e 100644 --- a/t/011_create_class.t +++ b/t/011_create_class.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 27; +use Test::More; use Test::Exception; use Class::MOP; @@ -16,7 +16,7 @@ my $Point = Class::MOP::Class->create('Point' => ( Class::MOP::Attribute->new('y' => ( accessor => 'y', init_arg => 'y' - )), + )), ], methods => { 'new' => sub { @@ -27,13 +27,13 @@ my $Point = Class::MOP::Class->create('Point' => ( 'clear' => sub { my $self = shift; $self->{'x'} = 0; - $self->{'y'} = 0; + $self->{'y'} = 0; } } )); my $Point3D = Class::MOP::Class->create('Point3D' => ( - version => '0.01', + version => '0.01', superclasses => [ 'Point' ], attributes => [ Class::MOP::Attribute->new('z' => ( @@ -103,11 +103,11 @@ is($point3d->{'z'}, 3, '... the z attribute was initialized correctly through th { my $point3d = Point3D->new(); isa_ok($point3d, 'Point3D'); - + is($point3d->x, undef, '... the x attribute was not initialized'); is($point3d->y, undef, '... the y attribute was not initialized'); - is($point3d->{'z'}, 123, '... the z attribute was initialized correctly through the metaobject'); - -} + is($point3d->{'z'}, 123, '... the z attribute was initialized correctly through the metaobject'); +} +done_testing; diff --git a/t/012_package_variables.t b/t/012_package_variables.t index 860ddb5..edba650 100644 --- a/t/012_package_variables.t +++ b/t/012_package_variables.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 86; +use Test::More; use Test::Exception; use Class::MOP; @@ -13,7 +13,7 @@ use Class::MOP; =pod -This is the same test as 080_meta_package.t just here +This is the same test as 080_meta_package.t just here we call all the methods through Class::MOP::Class. =cut @@ -28,7 +28,7 @@ lives_ok { Foo->meta->add_package_symbol('%foo' => { one => 1 }); } '... created %Foo::foo successfully'; -# ... scalar should NOT be created here +# ... scalar should NOT be created here ok(!Foo->meta->has_package_symbol('$foo'), '... SCALAR shouldnt have been created too'); ok(!Foo->meta->has_package_symbol('@foo'), '... ARRAY shouldnt have been created too'); @@ -55,9 +55,9 @@ $foo->{two} = 2; { no strict 'refs'; is(\%{'Foo::foo'}, Foo->meta->get_package_symbol('%foo'), '... our %foo is the same as the metas'); - + ok(exists ${'Foo::foo'}{two}, '... our %foo was updated correctly'); - is(${'Foo::foo'}{two}, 2, '... our %foo was updated correctly'); + is(${'Foo::foo'}{two}, 2, '... our %foo was updated correctly'); } # ---------------------------------------------------------------------- @@ -72,7 +72,7 @@ lives_ok { ok(defined($Foo::{bar}), '... the @bar slot was created successfully'); ok(Foo->meta->has_package_symbol('@bar'), '... the meta agrees'); -# ... why does this not work ... +# ... why does this not work ... ok(!Foo->meta->has_package_symbol('$bar'), '... SCALAR shouldnt have been created too'); ok(!Foo->meta->has_package_symbol('%bar'), '... HASH shouldnt have been created too'); @@ -102,14 +102,14 @@ ok(!Foo->meta->has_package_symbol('@baz'), '... ARRAY shouldnt have been created ok(!Foo->meta->has_package_symbol('%baz'), '... HASH shouldnt have been created too'); ok(!Foo->meta->has_package_symbol('&baz'), '... CODE shouldnt have been created too'); -is(${Foo->meta->get_package_symbol('$baz')}, 10, '... got the right value back'); +is(${Foo->meta->get_package_symbol('$baz')}, 10, '... got the right value back'); { no strict 'refs'; ${'Foo::baz'} = 1; is(${'Foo::baz'}, 1, '... our $baz was assigned to correctly'); - is(${Foo->meta->get_package_symbol('$baz')}, 1, '... the meta agrees'); + is(${Foo->meta->get_package_symbol('$baz')}, 1, '... the meta agrees'); } # ---------------------------------------------------------------------- @@ -184,9 +184,9 @@ is(Foo->meta->get_package_symbol('$foo'), $SCALAR, '... got the right value for { no strict 'refs'; ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); - ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); - ok(defined(*{"Foo::foo"}{CODE}), '... the &foo slot has NOT been removed'); - ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed'); + ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); + ok(defined(*{"Foo::foo"}{CODE}), '... the &foo slot has NOT been removed'); + ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed'); } lives_ok { @@ -203,10 +203,10 @@ is(Foo->meta->get_package_symbol('$foo'), $SCALAR, '... got the right value for { no strict 'refs'; - ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); - ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed'); - ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); - ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed'); + ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); + ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed'); + ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); + ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed'); } lives_ok { @@ -221,10 +221,10 @@ is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for { no strict 'refs'; - ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); - ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed'); - ok(!defined(${"Foo::foo"}), '... the $foo slot has now been removed'); - ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); + ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); + ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed'); + ok(!defined(${"Foo::foo"}), '... the $foo slot has now been removed'); + ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); } @@ -245,3 +245,5 @@ dies_ok { dies_ok { Foo->meta->has_package_symbol('bar'); } '... no sigil for bar'; + +done_testing; diff --git a/t/013_add_attribute_alternate.t b/t/013_add_attribute_alternate.t index f133d3e..4cfb338 100644 --- a/t/013_add_attribute_alternate.t +++ b/t/013_add_attribute_alternate.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 27; +use Test::More; use Test::Exception; use Class::MOP; @@ -28,12 +28,12 @@ use Class::MOP; sub clear { my $self = shift; $self->{'x'} = 0; - $self->{'y'} = 0; + $self->{'y'} = 0; } package Point3D; our @ISA = ('Point'); - + Point3D->meta->add_attribute('z' => ( default => 123 )); @@ -99,9 +99,11 @@ is($point3d->{'z'}, 3, '... the z attribute was initialized correctly through th { my $point3d = Point3D->new(); isa_ok($point3d, 'Point3D'); - + is($point3d->x, undef, '... the x attribute was not initialized'); is($point3d->y, undef, '... the y attribute was not initialized'); - is($point3d->{'z'}, 123, '... the z attribute was initialized correctly through the metaobject'); - + is($point3d->{'z'}, 123, '... the z attribute was initialized correctly through the metaobject'); + } + +done_testing; diff --git a/t/014_attribute_introspection.t b/t/014_attribute_introspection.t index 8eb82ce..d221389 100644 --- a/t/014_attribute_introspection.t +++ b/t/014_attribute_introspection.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 71; +use Test::More; use Test::Exception; use Class::MOP; @@ -106,3 +106,5 @@ use Class::MOP; # wont worry about it for now. Maybe if I get # bored I will do it. } + +done_testing; diff --git a/t/015_metaclass_inheritance.t b/t/015_metaclass_inheritance.t index 4fead06..fc784c5 100644 --- a/t/015_metaclass_inheritance.t +++ b/t/015_metaclass_inheritance.t @@ -1,14 +1,14 @@ use strict; use warnings; -use Test::More tests => 9; +use Test::More; use Test::Exception; use Class::MOP; =pod -Test that a default set up will cause metaclasses to inherit +Test that a default set up will cause metaclasses to inherit the same metaclass type, but produce different metaclasses. =cut @@ -16,10 +16,10 @@ the same metaclass type, but produce different metaclasses. { package Foo; use metaclass; - + package Bar; use base 'Foo'; - + package Baz; use base 'Bar'; } @@ -42,3 +42,4 @@ is($baz_meta->name, 'Baz', '... baz_meta->name == Baz'); isnt($baz_meta, $bar_meta, '... Baz->meta != Bar->meta'); isnt($baz_meta, $foo_meta, '... Baz->meta != Foo->meta'); +done_testing; diff --git a/t/016_class_errors_and_edge_cases.t b/t/016_class_errors_and_edge_cases.t index df5fe2a..18429c5 100644 --- a/t/016_class_errors_and_edge_cases.t +++ b/t/016_class_errors_and_edge_cases.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 43; +use Test::More; use Test::Exception; use Class::MOP; @@ -10,10 +10,10 @@ use Class::MOP; dies_ok { Class::MOP::Class->initialize(); } '... initialize requires a name parameter'; - + dies_ok { Class::MOP::Class->initialize(''); - } '... initialize requires a name valid parameter'; + } '... initialize requires a name valid parameter'; dies_ok { Class::MOP::Class->initialize(bless {} => 'Foo'); @@ -24,14 +24,14 @@ use Class::MOP; dies_ok { Class::MOP::Class->_construct_class_instance(); } '... _construct_class_instance requires an :package parameter'; - + dies_ok { Class::MOP::Class->_construct_class_instance(':package' => undef); - } '... _construct_class_instance requires a defined :package parameter'; - + } '... _construct_class_instance requires a defined :package parameter'; + dies_ok { Class::MOP::Class->_construct_class_instance(':package' => ''); - } '... _construct_class_instance requires a valid :package parameter'; + } '... _construct_class_instance requires a valid :package parameter'; } @@ -39,19 +39,19 @@ use Class::MOP; dies_ok { Class::MOP::Class->create(); } '... create requires an package_name parameter'; - + dies_ok { Class::MOP::Class->create(undef); - } '... create requires a defined package_name parameter'; - + } '... create requires a defined package_name parameter'; + dies_ok { Class::MOP::Class->create(''); - } '... create requires a valid package_name parameter'; - + } '... create requires a valid package_name parameter'; + throws_ok { Class::MOP::Class->create('+++'); - } qr/^creation of \+\+\+ failed/, '... create requires a valid package_name parameter'; - + } qr/^creation of \+\+\+ failed/, '... create requires a valid package_name parameter'; + } { @@ -64,25 +64,25 @@ use Class::MOP; dies_ok { Class::MOP::Class->add_method(); } '... add_method dies as expected'; - + dies_ok { Class::MOP::Class->add_method(''); - } '... add_method dies as expected'; + } '... add_method dies as expected'; dies_ok { Class::MOP::Class->add_method('foo' => 'foo'); } '... add_method dies as expected'; - + dies_ok { Class::MOP::Class->add_method('foo' => []); - } '... add_method dies as expected'; + } '... add_method dies as expected'; } { dies_ok { Class::MOP::Class->has_method(); } '... has_method dies as expected'; - + dies_ok { Class::MOP::Class->has_method(''); } '... has_method dies as expected'; @@ -92,7 +92,7 @@ use Class::MOP; dies_ok { Class::MOP::Class->get_method(); } '... get_method dies as expected'; - + dies_ok { Class::MOP::Class->get_method(''); } '... get_method dies as expected'; @@ -102,7 +102,7 @@ use Class::MOP; dies_ok { Class::MOP::Class->remove_method(); } '... remove_method dies as expected'; - + dies_ok { Class::MOP::Class->remove_method(''); } '... remove_method dies as expected'; @@ -112,7 +112,7 @@ use Class::MOP; dies_ok { Class::MOP::Class->find_all_methods_by_name(); } '... find_all_methods_by_name dies as expected'; - + dies_ok { Class::MOP::Class->find_all_methods_by_name(''); } '... find_all_methods_by_name dies as expected'; @@ -129,7 +129,7 @@ use Class::MOP; dies_ok { Class::MOP::Class->has_attribute(); } '... has_attribute dies as expected'; - + dies_ok { Class::MOP::Class->has_attribute(''); } '... has_attribute dies as expected'; @@ -139,7 +139,7 @@ use Class::MOP; dies_ok { Class::MOP::Class->get_attribute(); } '... get_attribute dies as expected'; - + dies_ok { Class::MOP::Class->get_attribute(''); } '... get_attribute dies as expected'; @@ -149,7 +149,7 @@ use Class::MOP; dies_ok { Class::MOP::Class->remove_attribute(); } '... remove_attribute dies as expected'; - + dies_ok { Class::MOP::Class->remove_attribute(''); } '... remove_attribute dies as expected'; @@ -159,23 +159,23 @@ use Class::MOP; dies_ok { Class::MOP::Class->add_package_symbol(); } '... add_package_symbol dies as expected'; - + dies_ok { Class::MOP::Class->add_package_symbol(''); } '... add_package_symbol dies as expected'; - + dies_ok { Class::MOP::Class->add_package_symbol('foo'); - } '... add_package_symbol dies as expected'; - + } '... add_package_symbol dies as expected'; + dies_ok { Class::MOP::Class->add_package_symbol('&foo'); - } '... add_package_symbol dies as expected'; - + } '... add_package_symbol dies as expected'; + # throws_ok { # Class::MOP::Class->meta->add_package_symbol('@-'); -# } qr/^Could not create package variable \(\@\-\) because/, -# '... add_package_symbol dies as expected'; +# } qr/^Could not create package variable \(\@\-\) because/, +# '... add_package_symbol dies as expected'; } { @@ -189,7 +189,7 @@ use Class::MOP; dies_ok { Class::MOP::Class->has_package_symbol('foo'); - } '... has_package_symbol dies as expected'; + } '... has_package_symbol dies as expected'; } { @@ -203,7 +203,7 @@ use Class::MOP; dies_ok { Class::MOP::Class->get_package_symbol('foo'); - } '... get_package_symbol dies as expected'; + } '... get_package_symbol dies as expected'; } { @@ -217,6 +217,7 @@ use Class::MOP; dies_ok { Class::MOP::Class->remove_package_symbol('foo'); - } '... remove_package_symbol dies as expected'; + } '... remove_package_symbol dies as expected'; } +done_testing; diff --git a/t/017_add_method_modifier.t b/t/017_add_method_modifier.t index 37ecf5c..a9c7945 100644 --- a/t/017_add_method_modifier.t +++ b/t/017_add_method_modifier.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 21; +use Test::More; use Test::Exception; use Class::MOP; @@ -136,3 +136,4 @@ is( $checking_account->balance, 0, is( $savings_account->balance, 200, '... got the right savings balance after overdraft withdrawal' ); +done_testing; diff --git a/t/018_anon_class.t b/t/018_anon_class.t index ffeea41..d314e7a 100644 --- a/t/018_anon_class.t +++ b/t/018_anon_class.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 18; +use Test::More; use Test::Exception; use Class::MOP; @@ -11,7 +11,7 @@ use Class::MOP; use strict; use warnings; use metaclass; - + sub bar { 'Foo::bar' } } @@ -21,9 +21,9 @@ my $anon_class_id; { my $anon_class = Class::MOP::Class->create_anon_class(); isa_ok($anon_class, 'Class::MOP::Class'); - + ($anon_class_id) = ($anon_class->name =~ /Class::MOP::Class::__ANON__::SERIAL::(\d+)/); - + ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package exists'); like($anon_class->name, qr/Class::MOP::Class::__ANON__::SERIAL::[0-9]+/, '... got an anon class package name'); @@ -43,14 +43,14 @@ my $anon_class_id; lives_ok { $anon_class->add_method('foo' => sub { "__ANON__::foo" }); } '... added a method to my anon-class'; - ok($anon_class->has_method('foo'), '... we have a foo method now'); + ok($anon_class->has_method('foo'), '... we have a foo method now'); $instance = $anon_class->new_object(); - isa_ok($instance, $anon_class->name); - isa_ok($instance, 'Foo'); + isa_ok($instance, $anon_class->name); + isa_ok($instance, 'Foo'); is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method'); - is($instance->bar, 'Foo::bar', '... got the right return value of our bar method'); + is($instance->bar, 'Foo::bar', '... got the right return value of our bar method'); } ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package still exists'); @@ -65,4 +65,4 @@ isa_ok($instance_2, ('Class::MOP::Class::__ANON__::SERIAL::' . $anon_class_id)); ok(!$instance_2->isa('Foo'), '... but the new instance is not a Foo'); ok(!$instance_2->can('foo'), '... and it can no longer call the foo method'); - +done_testing; diff --git a/t/019_anon_class_keep_alive.t b/t/019_anon_class_keep_alive.t index 8ff651f..17aedac 100644 --- a/t/019_anon_class_keep_alive.t +++ b/t/019_anon_class_keep_alive.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 10; +use Test::More; use Test::Exception; use Class::MOP; @@ -50,3 +50,5 @@ is_deeply([$instance->meta->class_precedence_list], [$anon_class_name, 'Foo'], '... Anonymous instance has class precedence list', ); + +done_testing; diff --git a/t/020_attribute.t b/t/020_attribute.t index ee5e60b..48ddbf9 100644 --- a/t/020_attribute.t +++ b/t/020_attribute.t @@ -3,7 +3,7 @@ use warnings; use Scalar::Util 'reftype', 'blessed'; -use Test::More tests => 104; +use Test::More; use Test::Exception; use Class::MOP; @@ -30,13 +30,13 @@ dies_ok { Class::MOP::Attribute->name } q{... can't call name() as a class metho { my $reader = $attr->get_read_method_ref; - my $writer = $attr->get_write_method_ref; - + my $writer = $attr->get_write_method_ref; + ok(!blessed($reader), '... it is a plain old sub'); - ok(!blessed($writer), '... it is a plain old sub'); - + ok(!blessed($writer), '... it is a plain old sub'); + is(reftype($reader), 'CODE', '... it is a plain old sub'); - is(reftype($writer), 'CODE', '... it is a plain old sub'); + is(reftype($writer), 'CODE', '... it is a plain old sub'); } my $class = Class::MOP::Class->initialize('Foo'); @@ -47,19 +47,19 @@ dies_ok { Class::MOP::Attribute->name } q{... can't call name() as a class metho } '... attached a class successfully'; is($attr->associated_class, $class, '... the class was associated correctly'); - + ok(!$attr->get_read_method, '... $attr does not have an read method'); - ok(!$attr->get_write_method, '... $attr does not have an write method'); - + ok(!$attr->get_write_method, '... $attr does not have an write method'); + { my $reader = $attr->get_read_method_ref; - my $writer = $attr->get_write_method_ref; - + my $writer = $attr->get_write_method_ref; + ok(blessed($reader), '... it is a plain old sub'); - ok(blessed($writer), '... it is a plain old sub'); - + ok(blessed($writer), '... it is a plain old sub'); + isa_ok($reader, 'Class::MOP::Method'); - isa_ok($writer, 'Class::MOP::Method'); + isa_ok($writer, 'Class::MOP::Method'); } my $attr_clone = $attr->clone(); @@ -91,20 +91,20 @@ dies_ok { Class::MOP::Attribute->name } q{... can't call name() as a class metho ok(!$attr->has_accessor, '... $attr does not have an accessor'); ok(!$attr->has_reader, '... $attr does not have an reader'); ok(!$attr->has_writer, '... $attr does not have an writer'); - + ok(!$attr->get_read_method, '... $attr does not have an read method'); - ok(!$attr->get_write_method, '... $attr does not have an write method'); - + ok(!$attr->get_write_method, '... $attr does not have an write method'); + { my $reader = $attr->get_read_method_ref; - my $writer = $attr->get_write_method_ref; - + my $writer = $attr->get_write_method_ref; + ok(!blessed($reader), '... it is a plain old sub'); - ok(!blessed($writer), '... it is a plain old sub'); - + ok(!blessed($writer), '... it is a plain old sub'); + is(reftype($reader), 'CODE', '... it is a plain old sub'); - is(reftype($writer), 'CODE', '... it is a plain old sub'); - } + is(reftype($writer), 'CODE', '... it is a plain old sub'); + } my $attr_clone = $attr->clone(); isa_ok($attr_clone, 'Class::MOP::Attribute'); @@ -137,20 +137,20 @@ dies_ok { Class::MOP::Attribute->name } q{... can't call name() as a class metho ok(!$attr->has_reader, '... $attr does not have an reader'); ok(!$attr->has_writer, '... $attr does not have an writer'); - + is($attr->get_read_method, 'foo', '... $attr does not have an read method'); - is($attr->get_write_method, 'foo', '... $attr does not have an write method'); - + is($attr->get_write_method, 'foo', '... $attr does not have an write method'); + { my $reader = $attr->get_read_method_ref; - my $writer = $attr->get_write_method_ref; - + my $writer = $attr->get_write_method_ref; + ok(!blessed($reader), '... it is not a plain old sub'); - ok(!blessed($writer), '... it is not a plain old sub'); - + ok(!blessed($writer), '... it is not a plain old sub'); + is(reftype($reader), 'CODE', '... it is a plain old sub'); - is(reftype($writer), 'CODE', '... it is a plain old sub'); - } + is(reftype($writer), 'CODE', '... it is a plain old sub'); + } my $attr_clone = $attr->clone(); isa_ok($attr_clone, 'Class::MOP::Attribute'); @@ -181,20 +181,20 @@ dies_ok { Class::MOP::Attribute->name } q{... can't call name() as a class metho is($attr->writer, 'set_foo', '... $attr->writer == set_foo'); ok(!$attr->has_accessor, '... $attr does not have an accessor'); - + is($attr->get_read_method, 'get_foo', '... $attr does not have an read method'); - is($attr->get_write_method, 'set_foo', '... $attr does not have an write method'); - + is($attr->get_write_method, 'set_foo', '... $attr does not have an write method'); + { my $reader = $attr->get_read_method_ref; - my $writer = $attr->get_write_method_ref; - + my $writer = $attr->get_write_method_ref; + ok(!blessed($reader), '... it is not a plain old sub'); - ok(!blessed($writer), '... it is not a plain old sub'); - + ok(!blessed($writer), '... it is not a plain old sub'); + is(reftype($reader), 'CODE', '... it is a plain old sub'); - is(reftype($writer), 'CODE', '... it is a plain old sub'); - } + is(reftype($writer), 'CODE', '... it is a plain old sub'); + } my $attr_clone = $attr->clone(); isa_ok($attr_clone, 'Class::MOP::Attribute'); @@ -244,3 +244,5 @@ dies_ok { Class::MOP::Attribute->name } q{... can't call name() as a class metho is($attr->default(42), 42, 'passthrough for default on attribute'); } + +done_testing; diff --git a/t/021_attribute_errors_and_edge_cases.t b/t/021_attribute_errors_and_edge_cases.t index b3da244..a6a853d 100644 --- a/t/021_attribute_errors_and_edge_cases.t +++ b/t/021_attribute_errors_and_edge_cases.t @@ -1,11 +1,11 @@ use strict; use warnings; -use Test::More tests => 27; +use Test::More; use Test::Exception; -BEGIN {use Class::MOP;use Class::MOP::Attribute; -} +use Class::MOP; +use Class::MOP::Attribute; # most values are static @@ -201,3 +201,5 @@ BEGIN {use Class::MOP;use Class::MOP::Attribute; )); } '... can create accessors with reader/writers'; } + +done_testing; diff --git a/t/022_attribute_duplication.t b/t/022_attribute_duplication.t index 013f909..4c4073f 100644 --- a/t/022_attribute_duplication.t +++ b/t/022_attribute_duplication.t @@ -3,7 +3,7 @@ use warnings; use Scalar::Util; -use Test::More tests => 16; +use Test::More; use Class::MOP; @@ -18,40 +18,41 @@ one first. { package Foo; use metaclass; - - Foo->meta->add_attribute('bar' => + + Foo->meta->add_attribute('bar' => reader => 'get_bar', writer => 'set_bar', ); - + ::can_ok('Foo', 'get_bar'); - ::can_ok('Foo', 'set_bar'); + ::can_ok('Foo', 'set_bar'); ::ok(Foo->meta->has_attribute('bar'), '... Foo has the attribute bar'); - + my $bar_attr = Foo->meta->get_attribute('bar'); - + ::is($bar_attr->reader, 'get_bar', '... the bar attribute has the reader get_bar'); - ::is($bar_attr->writer, 'set_bar', '... the bar attribute has the writer set_bar'); - ::is($bar_attr->associated_class, Foo->meta, '... and the bar attribute is associated with Foo->meta'); - - Foo->meta->add_attribute('bar' => + ::is($bar_attr->writer, 'set_bar', '... the bar attribute has the writer set_bar'); + ::is($bar_attr->associated_class, Foo->meta, '... and the bar attribute is associated with Foo->meta'); + + Foo->meta->add_attribute('bar' => reader => 'assign_bar' - ); + ); ::ok(!Foo->can('get_bar'), '... Foo no longer has the get_bar method'); - ::ok(!Foo->can('set_bar'), '... Foo no longer has the set_bar method'); - ::can_ok('Foo', 'assign_bar'); + ::ok(!Foo->can('set_bar'), '... Foo no longer has the set_bar method'); + ::can_ok('Foo', 'assign_bar'); ::ok(Foo->meta->has_attribute('bar'), '... Foo still has the attribute bar'); - - my $bar_attr2 = Foo->meta->get_attribute('bar'); - + + my $bar_attr2 = Foo->meta->get_attribute('bar'); + ::isnt($bar_attr, $bar_attr2, '... this is a new bar attribute'); - ::isnt($bar_attr->associated_class, Foo->meta, '... and the old bar attribute is no longer associated with Foo->meta'); - - ::is($bar_attr2->associated_class, Foo->meta, '... and the new bar attribute *is* associated with Foo->meta'); - + ::isnt($bar_attr->associated_class, Foo->meta, '... and the old bar attribute is no longer associated with Foo->meta'); + + ::is($bar_attr2->associated_class, Foo->meta, '... and the new bar attribute *is* associated with Foo->meta'); + ::isnt($bar_attr2->reader, 'get_bar', '... the bar attribute no longer has the reader get_bar'); - ::isnt($bar_attr2->reader, 'set_bar', '... the bar attribute no longer has the reader set_bar'); - ::is($bar_attr2->reader, 'assign_bar', '... the bar attribute now has the reader assign_bar'); + ::isnt($bar_attr2->reader, 'set_bar', '... the bar attribute no longer has the reader set_bar'); + ::is($bar_attr2->reader, 'assign_bar', '... the bar attribute now has the reader assign_bar'); } +done_testing; diff --git a/t/023_attribute_get_read_write.t b/t/023_attribute_get_read_write.t index cc08a5f..9f621a6 100644 --- a/t/023_attribute_get_read_write.t +++ b/t/023_attribute_get_read_write.t @@ -3,7 +3,7 @@ use warnings; use Scalar::Util 'blessed', 'reftype'; -use Test::More tests => 36; +use Test::More; use Class::MOP; @@ -17,19 +17,19 @@ and get_read/write_method_ref methods { package Foo; use metaclass; - - Foo->meta->add_attribute('bar' => + + Foo->meta->add_attribute('bar' => reader => 'get_bar', writer => 'set_bar', - ); - - Foo->meta->add_attribute('baz' => + ); + + Foo->meta->add_attribute('baz' => accessor => 'baz', - ); - - Foo->meta->add_attribute('gorch' => + ); + + Foo->meta->add_attribute('gorch' => reader => { 'get_gorch', => sub { (shift)->{gorch} } } - ); + ); package Bar; use metaclass; @@ -41,9 +41,9 @@ and get_read/write_method_ref methods } can_ok('Foo', 'get_bar'); -can_ok('Foo', 'set_bar'); -can_ok('Foo', 'baz'); -can_ok('Foo', 'get_gorch'); +can_ok('Foo', 'set_bar'); +can_ok('Foo', 'baz'); +can_ok('Foo', 'get_gorch'); ok(Foo->meta->has_attribute('bar'), '... Foo has the attribute bar'); ok(Foo->meta->has_attribute('baz'), '... Foo has the attribute baz'); @@ -54,59 +54,61 @@ my $baz_attr = Foo->meta->get_attribute('baz'); my $gorch_attr = Foo->meta->get_attribute('gorch'); is($bar_attr->reader, 'get_bar', '... the bar attribute has the reader get_bar'); -is($bar_attr->writer, 'set_bar', '... the bar attribute has the writer set_bar'); +is($bar_attr->writer, 'set_bar', '... the bar attribute has the writer set_bar'); is($bar_attr->associated_class, Foo->meta, '... and the bar attribute is associated with Foo->meta'); is($bar_attr->get_read_method, 'get_bar', '... $attr does have an read method'); -is($bar_attr->get_write_method, 'set_bar', '... $attr does have an write method'); +is($bar_attr->get_write_method, 'set_bar', '... $attr does have an write method'); { my $reader = $bar_attr->get_read_method_ref; - my $writer = $bar_attr->get_write_method_ref; - + my $writer = $bar_attr->get_write_method_ref; + isa_ok($reader, 'Class::MOP::Method'); - isa_ok($writer, 'Class::MOP::Method'); - + isa_ok($writer, 'Class::MOP::Method'); + is($reader->fully_qualified_name, 'Foo::get_bar', '... it is the sub we are looking for'); is($writer->fully_qualified_name, 'Foo::set_bar', '... it is the sub we are looking for'); - + is(reftype($reader->body), 'CODE', '... it is a plain old sub'); - is(reftype($writer->body), 'CODE', '... it is a plain old sub'); + is(reftype($writer->body), 'CODE', '... it is a plain old sub'); } is($baz_attr->accessor, 'baz', '... the bar attribute has the accessor baz'); is($baz_attr->associated_class, Foo->meta, '... and the bar attribute is associated with Foo->meta'); is($baz_attr->get_read_method, 'baz', '... $attr does have an read method'); -is($baz_attr->get_write_method, 'baz', '... $attr does have an write method'); +is($baz_attr->get_write_method, 'baz', '... $attr does have an write method'); { my $reader = $baz_attr->get_read_method_ref; - my $writer = $baz_attr->get_write_method_ref; - + my $writer = $baz_attr->get_write_method_ref; + isa_ok($reader, 'Class::MOP::Method'); - isa_ok($writer, 'Class::MOP::Method'); - - is($reader, $writer, '... they are the same method'); - + isa_ok($writer, 'Class::MOP::Method'); + + is($reader, $writer, '... they are the same method'); + is($reader->fully_qualified_name, 'Foo::baz', '... it is the sub we are looking for'); - is($writer->fully_qualified_name, 'Foo::baz', '... it is the sub we are looking for'); + is($writer->fully_qualified_name, 'Foo::baz', '... it is the sub we are looking for'); } is(ref($gorch_attr->reader), 'HASH', '... the gorch attribute has the reader get_gorch (HASH ref)'); is($gorch_attr->associated_class, Foo->meta, '... and the gorch attribute is associated with Foo->meta'); is($gorch_attr->get_read_method, 'get_gorch', '... $attr does have an read method'); -ok(!$gorch_attr->get_write_method, '... $attr does not have an write method'); +ok(!$gorch_attr->get_write_method, '... $attr does not have an write method'); { my $reader = $gorch_attr->get_read_method_ref; - my $writer = $gorch_attr->get_write_method_ref; - + my $writer = $gorch_attr->get_write_method_ref; + isa_ok($reader, 'Class::MOP::Method'); - ok(blessed($writer), '... it is not a plain old sub'); - isa_ok($writer, 'Class::MOP::Method'); - + ok(blessed($writer), '... it is not a plain old sub'); + isa_ok($writer, 'Class::MOP::Method'); + is($reader->fully_qualified_name, 'Foo::get_gorch', '... it is the sub we are looking for'); - is($writer->fully_qualified_name, 'Foo::__ANON__', '... it is the sub we are looking for'); + is($writer->fully_qualified_name, 'Foo::__ANON__', '... it is the sub we are looking for'); } + +done_testing; diff --git a/t/024_attribute_initializer.t b/t/024_attribute_initializer.t index 328ff7c..c61c7cb 100644 --- a/t/024_attribute_initializer.t +++ b/t/024_attribute_initializer.t @@ -3,7 +3,7 @@ use warnings; use Scalar::Util 'blessed', 'reftype'; -use Test::More tests => 9; +use Test::More; use Class::MOP; @@ -16,23 +16,23 @@ This checks that the initializer is used to set the initial value. { package Foo; use metaclass; - - Foo->meta->add_attribute('bar' => + + Foo->meta->add_attribute('bar' => reader => 'get_bar', writer => 'set_bar', initializer => sub { my ($self, $value, $callback, $attr) = @_; - + ::isa_ok($attr, 'Class::MOP::Attribute'); ::is($attr->name, 'bar', '... the attribute is our own'); - + $callback->($value * 2); }, - ); + ); } can_ok('Foo', 'get_bar'); -can_ok('Foo', 'set_bar'); +can_ok('Foo', 'set_bar'); my $foo = Foo->meta->new_object(bar => 10); is($foo->get_bar, 20, "... initial argument was doubled as expected"); @@ -49,11 +49,4 @@ isa_ok($bar, 'Class::MOP::Attribute'); ok($bar->has_initializer, '... bar has an initializer'); is(reftype $bar->initializer, 'CODE', '... the initializer is a CODE ref'); - - - - - - - - +done_testing; diff --git a/t/030_method.t b/t/030_method.t index 71cc17d..89605f0 100644 --- a/t/030_method.t +++ b/t/030_method.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 53; +use Test::More; use Test::Exception; use Class::MOP; @@ -159,3 +159,5 @@ is($wrapped->name, '__ANON__', 'method name copied properly'); my $wrapped2 = Method::Subclass->wrap($method, foo => 'baz', name => 'FOO'); is($wrapped2->name, 'FOO', 'got a new method name'); + +done_testing; diff --git a/t/031_method_modifiers.t b/t/031_method_modifiers.t index 4ab736f..ee5abf6 100644 --- a/t/031_method_modifiers.t +++ b/t/031_method_modifiers.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 28; +use Test::More; use Test::Exception; use Class::MOP; @@ -206,3 +206,4 @@ use Class::MOP::Method; 'check around_modifiers' ); } +done_testing; diff --git a/t/032_universal_methods.t b/t/032_universal_methods.t index c0b5ba8..29d94df 100644 --- a/t/032_universal_methods.t +++ b/t/032_universal_methods.t @@ -13,8 +13,6 @@ my $meta_class = Class::MOP::Class->create_anon_class; my @universal_methods = qw/isa can VERSION/; push @universal_methods, 'DOES' if $] >= 5.010; -plan tests => scalar @universal_methods; - TODO: { local $TODO = 'UNIVERSAL methods should be available'; @@ -22,3 +20,5 @@ TODO: { ok $meta_class->find_method_by_name($method), "has UNIVERSAL method $method"; } }; + +done_testing; diff --git a/t/040_metaclass.t b/t/040_metaclass.t index 72d0443..b2f3835 100644 --- a/t/040_metaclass.t +++ b/t/040_metaclass.t @@ -1,15 +1,14 @@ use strict; use warnings; -use Test::More tests => 11; +use Test::More; -BEGIN {use metaclass; -} +use metaclass; { package FooMeta; use base 'Class::MOP::Class'; - + package Foo; use metaclass 'FooMeta'; } @@ -21,17 +20,17 @@ isa_ok(Foo->meta, 'Class::MOP::Class'); { package BarMeta; use base 'Class::MOP::Class'; - + package BarMeta::Attribute; use base 'Class::MOP::Attribute'; - + package BarMeta::Method; - use base 'Class::MOP::Method'; - + use base 'Class::MOP::Method'; + package Bar; use metaclass 'BarMeta' => ( 'attribute_metaclass' => 'BarMeta::Attribute', - 'method_metaclass' => 'BarMeta::Method', + 'method_metaclass' => 'BarMeta::Method', ); } @@ -50,9 +49,10 @@ is(Bar->meta->method_metaclass, 'BarMeta::Method', '... got the right method met can_ok('Baz', 'meta'); isa_ok(Baz->meta, 'Class::MOP::Class'); -eval { +eval { package Boom; metaclass->import('Foo'); }; ok($@, '... metaclasses must be subclass of Class::MOP::Class'); +done_testing; diff --git a/t/041_metaclass_incompatibility.t b/t/041_metaclass_incompatibility.t index 444019f..80f693e 100644 --- a/t/041_metaclass_incompatibility.t +++ b/t/041_metaclass_incompatibility.t @@ -1,19 +1,18 @@ use strict; use warnings; -use Test::More tests => 6; +use Test::More; -BEGIN {use metaclass; -} +use metaclass; # meta classes { package Foo::Meta; use base 'Class::MOP::Class'; - + package Bar::Meta; use base 'Class::MOP::Class'; - + package FooBar::Meta; use base 'Foo::Meta', 'Bar::Meta'; } @@ -64,4 +63,4 @@ eval { }; ok(!$@, '... FooBar2.meta => FooBar::Meta is compatible') || diag $@; - +done_testing; diff --git a/t/042_metaclass_incompatibility_dyn.t b/t/042_metaclass_incompatibility_dyn.t index 2185566..4dab002 100644 --- a/t/042_metaclass_incompatibility_dyn.t +++ b/t/042_metaclass_incompatibility_dyn.t @@ -1,19 +1,18 @@ use strict; use warnings; -use Test::More tests => 6; +use Test::More; -BEGIN {use metaclass; -} +use metaclass; # meta classes { package Foo::Meta; use base 'Class::MOP::Class'; - + package Bar::Meta; use base 'Class::MOP::Class'; - + package FooBar::Meta; use base 'Foo::Meta', 'Bar::Meta'; } @@ -36,7 +35,7 @@ $@ = undef; eval { package Foo::Foo; metaclass->import('Bar::Meta'); - Foo::Foo->meta->superclasses('Foo'); + Foo::Foo->meta->superclasses('Foo'); }; ok($@, '... Foo::Foo.meta => Bar::Meta is not compatible') || diag $@; @@ -52,7 +51,7 @@ $@ = undef; eval { package FooBar; metaclass->import('FooBar::Meta'); - FooBar->meta->superclasses('Foo'); + FooBar->meta->superclasses('Foo'); }; ok(!$@, '... FooBar.meta => FooBar::Meta is compatible') || diag $@; @@ -60,8 +59,8 @@ $@ = undef; eval { package FooBar2; metaclass->import('FooBar::Meta'); - FooBar2->meta->superclasses('Bar'); + FooBar2->meta->superclasses('Bar'); }; ok(!$@, '... FooBar2.meta => FooBar::Meta is compatible') || diag $@; - +done_testing; diff --git a/t/043_instance_metaclass_incompat.t b/t/043_instance_metaclass_incompat.t index 55707f2..8439120 100644 --- a/t/043_instance_metaclass_incompat.t +++ b/t/043_instance_metaclass_incompat.t @@ -1,19 +1,18 @@ use strict; use warnings; -use Test::More tests => 6; +use Test::More; -BEGIN {use metaclass; -} +use metaclass; # meta classes -{ +{ package Foo::Meta::Instance; - use base 'Class::MOP::Instance'; - + use base 'Class::MOP::Instance'; + package Bar::Meta::Instance; - use base 'Class::MOP::Instance'; - + use base 'Class::MOP::Instance'; + package FooBar::Meta::Instance; use base 'Foo::Meta::Instance', 'Bar::Meta::Instance'; } @@ -44,7 +43,7 @@ $@ = undef; eval { package Bar::Bar; use base 'Bar'; - metaclass->import('instance_metaclass' => 'Foo::Meta::Instance'); + metaclass->import('instance_metaclass' => 'Foo::Meta::Instance'); }; ok($@, '... Bar::Bar.meta => Foo::Meta is not compatible') || diag $@; @@ -52,7 +51,7 @@ $@ = undef; eval { package FooBar; use base 'Foo'; - metaclass->import('instance_metaclass' => 'FooBar::Meta::Instance'); + metaclass->import('instance_metaclass' => 'FooBar::Meta::Instance'); }; ok(!$@, '... FooBar.meta => FooBar::Meta is compatible') || diag $@; @@ -60,8 +59,8 @@ $@ = undef; eval { package FooBar2; use base 'Bar'; - metaclass->import('instance_metaclass' => 'FooBar::Meta::Instance'); + metaclass->import('instance_metaclass' => 'FooBar::Meta::Instance'); }; ok(!$@, '... FooBar2.meta => FooBar::Meta is compatible') || diag $@; - +done_testing; diff --git a/t/044_instance_metaclass_incompat_dyn.t b/t/044_instance_metaclass_incompat_dyn.t index 464a6fb..2dbb8d2 100644 --- a/t/044_instance_metaclass_incompat_dyn.t +++ b/t/044_instance_metaclass_incompat_dyn.t @@ -1,19 +1,18 @@ use strict; use warnings; -use Test::More tests => 6; +use Test::More; -BEGIN {use metaclass; -} +use metaclass; # meta classes -{ +{ package Foo::Meta::Instance; - use base 'Class::MOP::Instance'; - + use base 'Class::MOP::Instance'; + package Bar::Meta::Instance; - use base 'Class::MOP::Instance'; - + use base 'Class::MOP::Instance'; + package FooBar::Meta::Instance; use base 'Foo::Meta::Instance', 'Bar::Meta::Instance'; } @@ -36,14 +35,14 @@ $@ = undef; eval { package Foo::Foo; metaclass->import('instance_metaclass' => 'Bar::Meta::Instance'); - Foo::Foo->meta->superclasses('Foo'); + Foo::Foo->meta->superclasses('Foo'); }; ok($@, '... Foo::Foo.meta => Bar::Meta is not compatible') || diag $@; $@ = undef; eval { package Bar::Bar; - metaclass->import('instance_metaclass' => 'Foo::Meta::Instance'); + metaclass->import('instance_metaclass' => 'Foo::Meta::Instance'); Bar::Bar->meta->superclasses('Bar'); }; ok($@, '... Bar::Bar.meta => Foo::Meta is not compatible') || diag $@; @@ -51,17 +50,17 @@ ok($@, '... Bar::Bar.meta => Foo::Meta is not compatible') || diag $@; $@ = undef; eval { package FooBar; - metaclass->import('instance_metaclass' => 'FooBar::Meta::Instance'); - FooBar->meta->superclasses('Foo'); + metaclass->import('instance_metaclass' => 'FooBar::Meta::Instance'); + FooBar->meta->superclasses('Foo'); }; ok(!$@, '... FooBar.meta => FooBar::Meta is compatible') || diag $@; $@ = undef; eval { package FooBar2; - metaclass->import('instance_metaclass' => 'FooBar::Meta::Instance'); - FooBar2->meta->superclasses('Bar'); + metaclass->import('instance_metaclass' => 'FooBar::Meta::Instance'); + FooBar2->meta->superclasses('Bar'); }; ok(!$@, '... FooBar2.meta => FooBar::Meta is compatible') || diag $@; - +done_testing; diff --git a/t/045_metaclass_loads_classes.t b/t/045_metaclass_loads_classes.t index f41f220..5ae9069 100644 --- a/t/045_metaclass_loads_classes.t +++ b/t/045_metaclass_loads_classes.t @@ -4,7 +4,7 @@ use warnings; use FindBin; use File::Spec::Functions; -use Test::More tests => 8; +use Test::More; use Class::MOP; @@ -37,3 +37,5 @@ ok(Class::MOP::is_class_loaded('MyMetaClass::Instance'), '... instance metaclass is($meta->method_metaclass, 'MyMetaClass::Method', '... Correct method metaclass'); ok(Class::MOP::is_class_loaded('MyMetaClass::Method'), '... method metaclass loaded'); + +done_testing; diff --git a/t/046_rebless_instance.t b/t/046_rebless_instance.t index 74a5502..f5e8b0e 100644 --- a/t/046_rebless_instance.t +++ b/t/046_rebless_instance.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 27; +use Test::More; use Test::Exception; use Scalar::Util 'blessed'; @@ -73,3 +73,4 @@ ok($bar->meta->has_method('child'), 'metaclass has "child" method'); is(blessed($bar->meta->new_object), 'Child', 'new_object gives a Child'); +done_testing; diff --git a/t/047_rebless_with_extra_params.t b/t/047_rebless_with_extra_params.t index 1269d76..5196ebf 100644 --- a/t/047_rebless_with_extra_params.t +++ b/t/047_rebless_with_extra_params.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 21; +use Test::More; use Test::Exception; use Class::MOP; @@ -10,13 +10,13 @@ use Class::MOP; package Foo; use metaclass; Foo->meta->add_attribute('bar' => (reader => 'bar')); - + sub new { (shift)->meta->new_object(@_) } - + package Bar; use metaclass; use base 'Foo'; - Bar->meta->add_attribute('baz' => (reader => 'baz', default => 'BAZ')); + Bar->meta->add_attribute('baz' => (reader => 'baz', default => 'BAZ')); } # normal ... @@ -70,4 +70,4 @@ use Class::MOP; is($foo->baz, 'FOO-BAZ', '... got the expect value'); } - +done_testing; diff --git a/t/048_anon_class_create_init.t b/t/048_anon_class_create_init.t index 8583284..42d4f14 100644 --- a/t/048_anon_class_create_init.t +++ b/t/048_anon_class_create_init.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 2; +use Test::More; use Class::MOP; @@ -21,3 +21,4 @@ use Class::MOP; my $anon = MyMeta->create_anon_class( foo => 'this' ); isa_ok( $anon, 'MyMeta' ); +done_testing; diff --git a/t/049_metaclass_reinitialize.t b/t/049_metaclass_reinitialize.t index 43815b0..a9c0e26 100644 --- a/t/049_metaclass_reinitialize.t +++ b/t/049_metaclass_reinitialize.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 14; +use Test::More; use Test::Exception; { @@ -39,3 +39,5 @@ throws_ok { throws_ok { $meta->reinitialize($meta->new_object); } qr/You must pass a package name or an existing Class::MOP::Package instance/; + +done_testing; diff --git a/t/050_scala_style_mixin_composition.t b/t/050_scala_style_mixin_composition.t index 2078494..3c46368 100644 --- a/t/050_scala_style_mixin_composition.t +++ b/t/050_scala_style_mixin_composition.t @@ -6,25 +6,24 @@ use Test::More; BEGIN { eval "use SUPER 1.10"; plan skip_all => "SUPER 1.10 required for this test" if $@; - plan tests => 4; } =pod -This test demonstrates how simple it is to create Scala Style -Class Mixin Composition. Below is an example taken from the +This test demonstrates how simple it is to create Scala Style +Class Mixin Composition. Below is an example taken from the Scala web site's example section, and trancoded to Class::MOP. NOTE: We require SUPER for this test to handle the issue with SUPER:: -being determined at compile time. +being determined at compile time. L -A class can only be used as a mixin in the definition of another -class, if this other class extends a subclass of the superclass -of the mixin. Since ColoredPoint3D extends Point3D and Point3D -extends Point2D which is the superclass of ColoredPoint2D, the +A class can only be used as a mixin in the definition of another +class, if this other class extends a subclass of the superclass +of the mixin. Since ColoredPoint3D extends Point3D and Point3D +extends Point2D which is the superclass of ColoredPoint2D, the code above is well-formed. class Point2D(xc: Int, yc: Int) { @@ -32,135 +31,135 @@ code above is well-formed. val y = yc; override def toString() = "x = " + x + ", y = " + y; } - + class ColoredPoint2D(u: Int, v: Int, c: String) extends Point2D(u, v) { val color = c; def setColor(newCol: String): Unit = color = newCol; override def toString() = super.toString() + ", col = " + color; } - + class Point3D(xc: Int, yc: Int, zc: Int) extends Point2D(xc, yc) { val z = zc; override def toString() = super.toString() + ", z = " + z; } - + class ColoredPoint3D(xc: Int, yc: Int, zc: Int, col: String) extends Point3D(xc, yc, zc) with ColoredPoint2D(xc, yc, col); - - + + Console.println(new ColoredPoint3D(1, 2, 3, "blue").toString()) - + "x = 1, y = 2, z = 3, col = blue" - + =cut use Scalar::Util 'blessed'; use Carp 'confess'; sub ::with ($) { - # fetch the metaclass for the + # fetch the metaclass for the # caller and the mixin arg my $metaclass = (caller)->meta; my $mixin = (shift)->meta; - - # according to Scala, the + + # according to Scala, the # the superclass of our class - # must be a subclass of the + # must be a subclass of the # superclass of the mixin (see above) my ($super_meta) = $metaclass->superclasses(); - my ($super_mixin) = $mixin->superclasses(); + my ($super_mixin) = $mixin->superclasses(); ($super_meta->isa($super_mixin)) || confess "The superclass must extend a subclass of the superclass of the mixin"; - + # collect all the attributes - # and clone them so they can + # and clone them so they can # associate with the new class - my @attributes = map { - $mixin->get_attribute($_)->clone() - } $mixin->get_attribute_list; - - my %methods = map { + my @attributes = map { + $mixin->get_attribute($_)->clone() + } $mixin->get_attribute_list; + + my %methods = map { my $method = $mixin->get_method($_); # we want to ignore accessors since # they will be created with the attrs (blessed($method) && $method->isa('Class::MOP::Method::Accessor')) ? () : ($_ => $method) - } $mixin->get_method_list; + } $mixin->get_method_list; # NOTE: - # I assume that locally defined methods + # I assume that locally defined methods # and attributes get precedence over those # from the mixin. # add all the attributes in .... foreach my $attr (@attributes) { - $metaclass->add_attribute($attr) + $metaclass->add_attribute($attr) unless $metaclass->has_attribute($attr->name); } - # add all the methods in .... + # add all the methods in .... foreach my $method_name (keys %methods) { - $metaclass->add_method($method_name => $methods{$method_name}) + $metaclass->add_method($method_name => $methods{$method_name}) unless $metaclass->has_method($method_name); - } + } } { package Point2D; use metaclass; - + Point2D->meta->add_attribute('$x' => ( accessor => 'x', init_arg => 'x', )); - + Point2D->meta->add_attribute('$y' => ( accessor => 'y', init_arg => 'y', - )); - + )); + sub new { my $class = shift; $class->meta->new_object(@_); - } - + } + sub toString { my $self = shift; "x = " . $self->x . ", y = " . $self->y; } - + package ColoredPoint2D; our @ISA = ('Point2D'); - + ColoredPoint2D->meta->add_attribute('$color' => ( accessor => 'color', init_arg => 'color', - )); - + )); + sub toString { my $self = shift; $self->SUPER() . ', col = ' . $self->color; } - + package Point3D; our @ISA = ('Point2D'); - + Point3D->meta->add_attribute('$z' => ( accessor => 'z', init_arg => 'z', - )); + )); sub toString { my $self = shift; $self->SUPER() . ', z = ' . $self->z; } - + package ColoredPoint3D; - our @ISA = ('Point3D'); - + our @ISA = ('Point3D'); + ::with('ColoredPoint2D'); - + } my $colored_point_3d = ColoredPoint3D->new(x => 1, y => 2, z => 3, color => 'blue'); @@ -172,4 +171,4 @@ is($colored_point_3d->toString(), 'x = 1, y = 2, z = 3, col = blue', '... got the right toString method'); - +done_testing; diff --git a/t/060_instance.t b/t/060_instance.t index b893744..d61e628 100644 --- a/t/060_instance.t +++ b/t/060_instance.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 45; +use Test::More; use Test::Exception; use Scalar::Util qw/isweak reftype/; @@ -9,12 +9,12 @@ use Scalar::Util qw/isweak reftype/; use Class::MOP::Instance; can_ok( "Class::MOP::Instance", $_ ) for qw/ - new + new create_instance bless_instance_structure - get_all_slots + get_all_slots initialize_all_slots deinitialize_all_slots @@ -136,3 +136,4 @@ ok(!$mi_foo->is_slot_initialized( $i_foo, "moosen" ), "slot deinitialized"); ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... no value for slot"); +done_testing; diff --git a/t/061_instance_inline.t b/t/061_instance_inline.t index 0141945..ec61805 100644 --- a/t/061_instance_inline.t +++ b/t/061_instance_inline.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 8; +use Test::More; use Test::Exception; use Class::MOP::Instance; @@ -45,4 +45,4 @@ my $C = 'Class::MOP::Instance'; '... got the right code for rebless_instance_structure'); } - +done_testing; diff --git a/t/070_immutable_metaclass.t b/t/070_immutable_metaclass.t index e6f716e..74d470a 100644 --- a/t/070_immutable_metaclass.t +++ b/t/070_immutable_metaclass.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 76; +use Test::More; use Test::Exception; use Class::MOP; @@ -312,3 +312,5 @@ use Class::MOP; 'custom immutable_options are returned by immutable_options accessor' ); } + +done_testing; diff --git a/t/071_immutable_w_custom_metaclass.t b/t/071_immutable_w_custom_metaclass.t index c81abb7..92c5f8a 100644 --- a/t/071_immutable_w_custom_metaclass.t +++ b/t/071_immutable_w_custom_metaclass.t @@ -4,7 +4,7 @@ use warnings; use FindBin; use File::Spec::Functions; -use Test::More tests => 14; +use Test::More; use Test::Exception; use Scalar::Util; @@ -71,3 +71,5 @@ use lib catdir( $FindBin::Bin, 'lib' ); lives_ok { $meta->make_mutable } "Baz is now mutable"; ok( $meta->is_mutable, '... Baz is mutable again' ); } + +done_testing; diff --git a/t/072_immutable_w_constructors.t b/t/072_immutable_w_constructors.t index 906d359..21b2ce8 100644 --- a/t/072_immutable_w_constructors.t +++ b/t/072_immutable_w_constructors.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 91; +use Test::More; use Test::Exception; use Class::MOP; @@ -297,3 +297,5 @@ use Class::MOP; ::is($buzz2->bah, undef, '...bah is undef'); } + +done_testing; diff --git a/t/073_make_mutable.t b/t/073_make_mutable.t index 59d3e4b..4070b5c 100644 --- a/t/073_make_mutable.t +++ b/t/073_make_mutable.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 95; +use Test::More; use Test::Exception; use Scalar::Util; @@ -50,7 +50,7 @@ use Class::MOP; ok($meta->is_immutable, '... our class is now immutable'); ok(!$meta->make_immutable, '... make immutable now returns nothing'); ok($meta->get_method('new'), '... inlined constructor created'); - ok($meta->has_method('new'), '... inlined constructor created for sure'); + ok($meta->has_method('new'), '... inlined constructor created for sure'); is_deeply([ map { $_->name } $meta->_inlined_methods ], [ 'new' ], '... really, i mean it'); lives_ok { $meta->make_mutable; } '... changed Baz to be mutable'; @@ -58,7 +58,7 @@ use Class::MOP; ok(!$meta->is_immutable, '... our class is not immutable'); ok(!$meta->make_mutable, '... make mutable now returns nothing'); ok(!$meta->get_method('new'), '... inlined constructor created'); - ok(!$meta->has_method('new'), '... inlined constructor removed for sure'); + ok(!$meta->has_method('new'), '... inlined constructor removed for sure'); my %new_keys = map { $_ => 1 } grep { !/^_/ } keys %$meta; is_deeply(\%orig_keys, \%new_keys, '... no extraneous hashkeys'); @@ -216,3 +216,5 @@ use Class::MOP; Bar->meta->make_immutable; Bar->meta->make_mutable; } + +done_testing; diff --git a/t/074_immutable_custom_trait.t b/t/074_immutable_custom_trait.t index 804c8a5..a29e957 100644 --- a/t/074_immutable_custom_trait.t +++ b/t/074_immutable_custom_trait.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 4; +use Test::More; use Test::Exception; use Class::MOP; @@ -74,3 +74,5 @@ use Class::MOP; 'Bar->meta->superclasses returns expected value after immutabilization' ); } + +done_testing; diff --git a/t/080_meta_package.t b/t/080_meta_package.t index a82ff27..0583d5d 100644 --- a/t/080_meta_package.t +++ b/t/080_meta_package.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 97; +use Test::More; use Test::Exception; use Class::MOP; @@ -15,7 +15,7 @@ dies_ok { Class::MOP::Package->name } q{... can't call name() as a class method} package Foo; use constant SOME_CONSTANT => 1; - + sub meta { Class::MOP::Package->initialize('Foo') } } @@ -30,7 +30,7 @@ lives_ok { Foo->meta->add_package_symbol('%foo' => { one => 1 }); } '... created %Foo::foo successfully'; -# ... scalar should NOT be created here +# ... scalar should NOT be created here ok(!Foo->meta->has_package_symbol('$foo'), '... SCALAR shouldnt have been created too'); ok(!Foo->meta->has_package_symbol('@foo'), '... ARRAY shouldnt have been created too'); @@ -57,9 +57,9 @@ $foo->{two} = 2; { no strict 'refs'; is(\%{'Foo::foo'}, Foo->meta->get_package_symbol('%foo'), '... our %foo is the same as the metas'); - + ok(exists ${'Foo::foo'}{two}, '... our %foo was updated correctly'); - is(${'Foo::foo'}{two}, 2, '... our %foo was updated correctly'); + is(${'Foo::foo'}{two}, 2, '... our %foo was updated correctly'); } # ---------------------------------------------------------------------- @@ -74,7 +74,7 @@ lives_ok { ok(defined($Foo::{bar}), '... the @bar slot was created successfully'); ok(Foo->meta->has_package_symbol('@bar'), '... the meta agrees'); -# ... why does this not work ... +# ... why does this not work ... ok(!Foo->meta->has_package_symbol('$bar'), '... SCALAR shouldnt have been created too'); ok(!Foo->meta->has_package_symbol('%bar'), '... HASH shouldnt have been created too'); @@ -104,14 +104,14 @@ ok(!Foo->meta->has_package_symbol('@baz'), '... ARRAY shouldnt have been created ok(!Foo->meta->has_package_symbol('%baz'), '... HASH shouldnt have been created too'); ok(!Foo->meta->has_package_symbol('&baz'), '... CODE shouldnt have been created too'); -is(${Foo->meta->get_package_symbol('$baz')}, 10, '... got the right value back'); +is(${Foo->meta->get_package_symbol('$baz')}, 10, '... got the right value back'); { no strict 'refs'; ${'Foo::baz'} = 1; is(${'Foo::baz'}, 1, '... our $baz was assigned to correctly'); - is(${Foo->meta->get_package_symbol('$baz')}, 1, '... the meta agrees'); + is(${Foo->meta->get_package_symbol('$baz')}, 1, '... the meta agrees'); } # ---------------------------------------------------------------------- @@ -186,9 +186,9 @@ is(Foo->meta->get_package_symbol('$foo'), $SCALAR, '... got the right value for { no strict 'refs'; ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); - ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); - ok(defined(*{"Foo::foo"}{CODE}), '... the &foo slot has NOT been removed'); - ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed'); + ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); + ok(defined(*{"Foo::foo"}{CODE}), '... the &foo slot has NOT been removed'); + ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed'); } lives_ok { @@ -205,10 +205,10 @@ is(Foo->meta->get_package_symbol('$foo'), $SCALAR, '... got the right value for { no strict 'refs'; - ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); - ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed'); - ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); - ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed'); + ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); + ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed'); + ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); + ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed'); } lives_ok { @@ -223,10 +223,10 @@ is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for { no strict 'refs'; - ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); - ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed'); - ok(!defined(${"Foo::foo"}), '... the $foo slot has now been removed'); - ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); + ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully'); + ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed'); + ok(!defined(${"Foo::foo"}), '... the $foo slot has now been removed'); + ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed'); } # get_all_package_symbols @@ -237,7 +237,7 @@ is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for [ sort keys %{ $syms } ], [ sort Foo->meta->list_all_package_symbols ], '... the fetched symbols are the same as the listed ones' - ); + ); } { @@ -248,10 +248,10 @@ is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for [ sort Foo->meta->list_all_package_symbols('CODE') ], '... the fetched symbols are the same as the listed ones' ); - + foreach my $symbol (keys %{ $syms }) { is($syms->{$symbol}, Foo->meta->get_package_symbol('&' . $symbol), '... got the right symbol'); - } + } } { @@ -293,3 +293,5 @@ dies_ok { dies_ok { Foo->meta->has_package_symbol('bar'); } '... no sigil for bar'; + +done_testing; diff --git a/t/081_meta_package_extension.t b/t/081_meta_package_extension.t index 8ede745..4ac0a06 100644 --- a/t/081_meta_package_extension.t +++ b/t/081_meta_package_extension.t @@ -1,39 +1,38 @@ use strict; use warnings; -use Test::More tests => 15; +use Test::More; use Test::Exception; -BEGIN {use Class::MOP; -} +use Class::MOP; { package My::Meta::Package; - + use strict; use warnings; - + use Carp 'confess'; use Symbol 'gensym'; - + use base 'Class::MOP::Package'; - + __PACKAGE__->meta->add_attribute( 'namespace' => ( reader => 'namespace', default => sub { {} } ) - ); - + ); + sub add_package_symbol { my ($self, $variable, $initial_value) = @_; - - my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); - + + my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); + my $glob = gensym(); *{$glob} = $initial_value if defined $initial_value; - $self->namespace->{$name} = *{$glob}; - } + $self->namespace->{$name} = *{$glob}; + } } # No actually package Foo exists :) @@ -75,3 +74,4 @@ lives_ok { ok(!defined($Foo::{baz}), '... the %baz slot has still not been created'); +done_testing; diff --git a/t/082_get_code_info.t b/t/082_get_code_info.t index 604a1fd..2770b76 100644 --- a/t/082_get_code_info.t +++ b/t/082_get_code_info.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 5; +use Test::More; use Sub::Name 'subname'; BEGIN { @@ -48,3 +48,5 @@ code_name_is( \&Class::MOP::Method::name, "Class::MOP::Method", "name" ); sub foo : Bar {} } + +done_testing; diff --git a/t/083_load_class.t b/t/083_load_class.t index c4569c5..67553be 100644 --- a/t/083_load_class.t +++ b/t/083_load_class.t @@ -1,6 +1,6 @@ use strict; use warnings; -use Test::More tests => 32; +use Test::More; use Test::Exception; require Class::MOP; @@ -145,3 +145,4 @@ throws_ok { 'an @ISA with members does mean a class is loaded' ); } +done_testing; diff --git a/t/085_load_class_gvstash_detect_bug.t b/t/085_load_class_gvstash_detect_bug.t index a3461bf..91e6171 100644 --- a/t/085_load_class_gvstash_detect_bug.t +++ b/t/085_load_class_gvstash_detect_bug.t @@ -1,6 +1,6 @@ use strict; use warnings; -use Test::More tests => 3; +use Test::More; use Test::Exception; use Class::MOP; @@ -18,4 +18,6 @@ lives_ok { lives_ok { TestClassLoaded->a_method; -} +}; + +done_testing; diff --git a/t/086_rebless_instance_away.t b/t/086_rebless_instance_away.t index 5d6a181..c86f416 100644 --- a/t/086_rebless_instance_away.t +++ b/t/086_rebless_instance_away.t @@ -1,7 +1,7 @@ #!/usr/bin/env perl use strict; use warnings; -use Test::More tests => 9; +use Test::More; use Class::MOP; my @calls; @@ -42,3 +42,4 @@ is($calls[0][3], 'foo'); is($calls[0][4], 1); splice @calls; +done_testing; diff --git a/t/087_subclasses.t b/t/087_subclasses.t index 8885cc3..5a213fb 100644 --- a/t/087_subclasses.t +++ b/t/087_subclasses.t @@ -1,6 +1,6 @@ use strict; use warnings; -use Test::More tests => 12; +use Test::More; use Class::MOP; do { @@ -42,3 +42,4 @@ is_deeply([sort Son->meta->direct_subclasses], []); is_deeply([sort Daughter->meta->direct_subclasses], []); is_deeply([sort Cousin->meta->direct_subclasses], []); +done_testing; diff --git a/t/100_BinaryTree_test.t b/t/100_BinaryTree_test.t index 16c1ca6..285994f 100644 --- a/t/100_BinaryTree_test.t +++ b/t/100_BinaryTree_test.t @@ -4,7 +4,7 @@ use warnings; use FindBin; use File::Spec::Functions; -use Test::More tests => 69; +use Test::More; use Test::Exception; use Class::MOP; @@ -329,3 +329,4 @@ sub inOrderTraverse { '... this should be the reverse of the original'); } +done_testing; diff --git a/t/101_InstanceCountingClass_test.t b/t/101_InstanceCountingClass_test.t index 155ea68..97bcf67 100644 --- a/t/101_InstanceCountingClass_test.t +++ b/t/101_InstanceCountingClass_test.t @@ -1,34 +1,36 @@ use strict; use warnings; -use Test::More tests => 11; +use Test::More; use File::Spec; -BEGIN {use Class::MOP; +use Class::MOP; + +BEGIN { require_ok(File::Spec->catfile('examples', 'InstanceCountingClass.pod')); } =pod -This is a trivial and contrived example of how to +This is a trivial and contrived example of how to make a metaclass which will count all the instances -created. It is not meant to be anything more than +created. It is not meant to be anything more than a simple demonstration of how to make a metaclass. =cut { package Foo; - + use metaclass 'InstanceCountingClass'; - + sub new { my $class = shift; $class->meta->new_object(@_); } - + package Bar; - + our @ISA = ('Foo'); } @@ -51,6 +53,7 @@ for (2 .. 10) { Foo->new(); } -is(Foo->meta->get_count(), 10, '... our Foo count is now 10'); +is(Foo->meta->get_count(), 10, '... our Foo count is now 10'); is(Bar->meta->get_count(), 1, '... our Bar count is still 1'); +done_testing; diff --git a/t/102_InsideOutClass_test.t b/t/102_InsideOutClass_test.t index 242d161..bc4c27c 100644 --- a/t/102_InsideOutClass_test.t +++ b/t/102_InsideOutClass_test.t @@ -1,81 +1,81 @@ use strict; use warnings; -use Test::More tests => 88; +use Test::More; use File::Spec; use Scalar::Util 'reftype'; -BEGIN {use Class::MOP; +BEGIN {use Class::MOP; require_ok(File::Spec->catfile('examples', 'InsideOutClass.pod')); } { package Foo; - + use strict; - use warnings; - + use warnings; + use metaclass ( 'attribute_metaclass' => 'InsideOutClass::Attribute', 'instance_metaclass' => 'InsideOutClass::Instance' ); - + Foo->meta->add_attribute('foo' => ( accessor => 'foo', predicate => 'has_foo', )); - + Foo->meta->add_attribute('bar' => ( reader => 'get_bar', writer => 'set_bar', - default => 'FOO is BAR' + default => 'FOO is BAR' )); - + sub new { my $class = shift; $class->meta->new_object(@_); } - + package Bar; use metaclass ( 'attribute_metaclass' => 'InsideOutClass::Attribute', 'instance_metaclass' => 'InsideOutClass::Instance' ); - + use strict; use warnings; - + use base 'Foo'; - + Bar->meta->add_attribute('baz' => ( accessor => 'baz', predicate => 'has_baz', - )); - + )); + package Baz; - + use strict; use warnings; - use metaclass ( + use metaclass ( 'attribute_metaclass' => 'InsideOutClass::Attribute', 'instance_metaclass' => 'InsideOutClass::Instance' ); - + Baz->meta->add_attribute('bling' => ( accessor => 'bling', default => 'Baz::bling' - )); - + )); + package Bar::Baz; use metaclass ( 'attribute_metaclass' => 'InsideOutClass::Attribute', 'instance_metaclass' => 'InsideOutClass::Instance' ); - + use strict; use warnings; - - use base 'Bar', 'Baz'; + + use base 'Bar', 'Baz'; } my $foo = Foo->new(); @@ -191,12 +191,12 @@ is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized'); { no strict 'refs'; - + ok(*{'Foo::foo'}{HASH}, '... there is a foo package variable in Foo'); ok(*{'Foo::bar'}{HASH}, '... there is a bar package variable in Foo'); is(scalar(keys(%{'Foo::foo'})), 4, '... got the right number of entries for Foo::foo'); - is(scalar(keys(%{'Foo::bar'})), 4, '... got the right number of entries for Foo::bar'); + is(scalar(keys(%{'Foo::bar'})), 4, '... got the right number of entries for Foo::bar'); ok(!*{'Bar::foo'}{HASH}, '... no foo package variable in Bar'); ok(!*{'Bar::bar'}{HASH}, '... no bar package variable in Bar'); @@ -205,11 +205,11 @@ is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized'); is(scalar(keys(%{'Bar::foo'})), 0, '... got the right number of entries for Bar::foo'); is(scalar(keys(%{'Bar::bar'})), 0, '... got the right number of entries for Bar::bar'); is(scalar(keys(%{'Bar::baz'})), 2, '... got the right number of entries for Bar::baz'); - + ok(*{'Baz::bling'}{HASH}, '... there is a bar package variable in Baz'); - is(scalar(keys(%{'Baz::bling'})), 1, '... got the right number of entries for Baz::bling'); - + is(scalar(keys(%{'Baz::bling'})), 1, '... got the right number of entries for Baz::bling'); + ok(!*{'Bar::Baz::foo'}{HASH}, '... no foo package variable in Bar::Baz'); ok(!*{'Bar::Baz::bar'}{HASH}, '... no bar package variable in Bar::Baz'); ok(!*{'Bar::Baz::baz'}{HASH}, '... no baz package variable in Bar::Baz'); @@ -217,6 +217,8 @@ is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized'); is(scalar(keys(%{'Bar::Baz::foo'})), 0, '... got the right number of entries for Bar::Baz::foo'); is(scalar(keys(%{'Bar::Baz::bar'})), 0, '... got the right number of entries for Bar::Baz::bar'); - is(scalar(keys(%{'Bar::Baz::baz'})), 0, '... got the right number of entries for Bar::Baz::baz'); - is(scalar(keys(%{'Bar::Baz::bling'})), 0, '... got the right number of entries for Bar::Baz::bling'); + is(scalar(keys(%{'Bar::Baz::baz'})), 0, '... got the right number of entries for Bar::Baz::baz'); + is(scalar(keys(%{'Bar::Baz::bling'})), 0, '... got the right number of entries for Bar::Baz::bling'); } + +done_testing; diff --git a/t/103_Perl6Attribute_test.t b/t/103_Perl6Attribute_test.t index 8311d0f..4c0b3dd 100644 --- a/t/103_Perl6Attribute_test.t +++ b/t/103_Perl6Attribute_test.t @@ -1,26 +1,28 @@ use strict; use warnings; -use Test::More tests => 9; +use Test::More; use File::Spec; -BEGIN {use Class::MOP; +use Class::MOP; + +BEGIN { require_ok(File::Spec->catfile('examples', 'Perl6Attribute.pod')); } { package Foo; - + use metaclass; - + Foo->meta->add_attribute(Perl6Attribute->new('$.foo')); - Foo->meta->add_attribute(Perl6Attribute->new('@.bar')); - Foo->meta->add_attribute(Perl6Attribute->new('%.baz')); - + Foo->meta->add_attribute(Perl6Attribute->new('@.bar')); + Foo->meta->add_attribute(Perl6Attribute->new('%.baz')); + sub new { my $class = shift; $class->meta->new_object(@_); - } + } } my $foo = Foo->new(); @@ -37,3 +39,5 @@ is($foo->foo, 42, '... Foo.foo == 42'); is_deeply($foo->bar, [], '... Foo.bar == []'); is_deeply($foo->baz, {}, '... Foo.baz == {}'); + +done_testing; diff --git a/t/104_AttributesWithHistory_test.t b/t/104_AttributesWithHistory_test.t index 7950ade..45c3887 100644 --- a/t/104_AttributesWithHistory_test.t +++ b/t/104_AttributesWithHistory_test.t @@ -1,32 +1,34 @@ use strict; use warnings; -use Test::More tests => 27; +use Test::More; use File::Spec; -BEGIN {use Class::MOP; +use Class::MOP; + +BEGIN { require_ok(File::Spec->catfile('examples', 'AttributesWithHistory.pod')); } { package Foo; use metaclass; - + Foo->meta->add_attribute(AttributesWithHistory->new('foo' => ( accessor => 'foo', history_accessor => 'get_foo_history', - ))); - + ))); + Foo->meta->add_attribute(AttributesWithHistory->new('bar' => ( reader => 'get_bar', writer => 'set_bar', history_accessor => 'get_bar_history', - ))); - + ))); + sub new { my $class = shift; $class->meta->new_object(@_); - } + } } my $foo = Foo->new(); @@ -46,12 +48,12 @@ is_deeply( [ $foo->get_foo_history() ], [ ], '... got correct empty history for foo'); - + is($foo2->foo, undef, '... foo2 is not yet defined'); is_deeply( [ $foo2->get_foo_history() ], [ ], - '... got correct empty history for foo2'); + '... got correct empty history for foo2'); $foo->foo(42); is($foo->foo, 42, '... foo == 42'); @@ -65,7 +67,7 @@ is_deeply( [ $foo2->get_foo_history() ], [ ], '... still got correct empty history for foo2'); - + $foo2->foo(100); is($foo->foo, 42, '... foo is still == 42'); is_deeply( @@ -87,7 +89,7 @@ $foo->foo(46); is_deeply( [ $foo->get_foo_history() ], [ 42, 43, 44, 45, 46 ], - '... got correct history for foo'); + '... got correct history for foo'); is($foo->get_bar, undef, '... bar is not yet defined'); is_deeply( @@ -115,3 +117,5 @@ is_deeply( [ $foo->get_foo_history() ], [ 42, 43, 44, 45, 46 ], '... still have the correct history for foo'); + +done_testing; diff --git a/t/105_ClassEncapsulatedAttributes_test.t b/t/105_ClassEncapsulatedAttributes_test.t index 3f29426..075f616 100644 --- a/t/105_ClassEncapsulatedAttributes_test.t +++ b/t/105_ClassEncapsulatedAttributes_test.t @@ -1,55 +1,57 @@ use strict; use warnings; -use Test::More tests => 28; +use Test::More; use File::Spec; -BEGIN {use Class::MOP; +use Class::MOP; + +BEGIN { require_ok(File::Spec->catfile('examples', 'ClassEncapsulatedAttributes.pod')); } { package Foo; - + use metaclass 'ClassEncapsulatedAttributes'; - + Foo->meta->add_attribute('foo' => ( accessor => 'foo', - predicate => 'has_foo', + predicate => 'has_foo', default => 'init in FOO' )); - + Foo->meta->add_attribute('bar' => ( reader => 'get_bar', writer => 'set_bar', default => 'init in FOO' )); - + sub new { my $class = shift; $class->meta->new_object(@_); } - + package Bar; our @ISA = ('Foo'); - + Bar->meta->add_attribute('foo' => ( accessor => 'foo', predicate => 'has_foo', - default => 'init in BAR' + default => 'init in BAR' )); - + Bar->meta->add_attribute('bar' => ( reader => 'get_bar', writer => 'set_bar', - default => 'init in BAR' + default => 'init in BAR' )); - + sub SUPER_foo { (shift)->SUPER::foo(@_) } - sub SUPER_has_foo { (shift)->SUPER::foo(@_) } - sub SUPER_get_bar { (shift)->SUPER::get_bar() } - sub SUPER_set_bar { (shift)->SUPER::set_bar(@_) } - + sub SUPER_has_foo { (shift)->SUPER::foo(@_) } + sub SUPER_get_bar { (shift)->SUPER::get_bar() } + sub SUPER_set_bar { (shift)->SUPER::set_bar(@_) } + } { @@ -74,13 +76,13 @@ BEGIN {use Class::MOP; is($foo->foo, 'init in FOO', '... got the right default value for Foo::foo'); is($bar->foo, 'init in BAR', '... got the right default value for Bar::foo'); - - is($bar->SUPER_foo(), 'init in FOO', '... got the right default value for Bar::SUPER::foo'); - + + is($bar->SUPER_foo(), 'init in FOO', '... got the right default value for Bar::SUPER::foo'); + $bar->SUPER_foo(undef); - is($bar->SUPER_foo(), undef, '... successfully set Foo::foo through Bar::SUPER::foo'); - ok(!$bar->SUPER_has_foo, '... BAR::SUPER::has_foo == 0'); + is($bar->SUPER_foo(), undef, '... successfully set Foo::foo through Bar::SUPER::foo'); + ok(!$bar->SUPER_has_foo, '... BAR::SUPER::has_foo == 0'); ok($foo->has_foo, '... Foo::has_foo (is still) 1'); } @@ -88,7 +90,7 @@ BEGIN {use Class::MOP; { my $bar = Bar->new( 'Foo' => { 'foo' => 'Foo::foo' }, - 'Bar' => { 'foo' => 'Bar::foo' } + 'Bar' => { 'foo' => 'Bar::foo' } ); isa_ok($bar, 'Bar'); @@ -98,9 +100,10 @@ BEGIN {use Class::MOP; can_ok($bar, 'set_bar'); ok($bar->has_foo, '... Bar::has_foo == 1'); - ok($bar->SUPER_has_foo, '... Bar::SUPER_has_foo == 1'); + ok($bar->SUPER_has_foo, '... Bar::SUPER_has_foo == 1'); - is($bar->foo, 'Bar::foo', '... got the right default value for Bar::foo'); - is($bar->SUPER_foo(), 'Foo::foo', '... got the right default value for Bar::SUPER::foo'); + is($bar->foo, 'Bar::foo', '... got the right default value for Bar::foo'); + is($bar->SUPER_foo(), 'Foo::foo', '... got the right default value for Bar::SUPER::foo'); } +done_testing; diff --git a/t/106_LazyClass_test.t b/t/106_LazyClass_test.t index 94c50fb..b380d46 100644 --- a/t/106_LazyClass_test.t +++ b/t/106_LazyClass_test.t @@ -1,35 +1,37 @@ use strict; use warnings; -use Test::More tests => 25; +use Test::More; use File::Spec; -BEGIN {use Class::MOP; +use Class::MOP; + +BEGIN { require_ok(File::Spec->catfile('examples', 'LazyClass.pod')); } { package BinaryTree; - + use metaclass ( 'attribute_metaclass' => 'LazyClass::Attribute', - 'instance_metaclass' => 'LazyClass::Instance', + 'instance_metaclass' => 'LazyClass::Instance', ); BinaryTree->meta->add_attribute('node' => ( accessor => 'node', init_arg => 'node' )); - + BinaryTree->meta->add_attribute('left' => ( reader => 'left', default => sub { BinaryTree->new() } )); - + BinaryTree->meta->add_attribute('right' => ( reader => 'right', - default => sub { BinaryTree->new() } - )); + default => sub { BinaryTree->new() } + )); sub new { my $class = shift; @@ -78,3 +80,4 @@ is($root->right->node(), 2, '... the right node == 1'); ok(!exists($root->right->{'left'}), '... left attribute still has not been initialized yet'); ok(!exists($root->right->{'right'}), '... right attribute still has not been initialized yet'); +done_testing; diff --git a/t/107_C3MethodDispatchOrder_test.t b/t/107_C3MethodDispatchOrder_test.t index b9b4bdb..d5ef265 100644 --- a/t/107_C3MethodDispatchOrder_test.t +++ b/t/107_C3MethodDispatchOrder_test.t @@ -3,32 +3,32 @@ use warnings; use Test::More; use File::Spec; +use Class::MOP; BEGIN { eval "use Algorithm::C3"; plan skip_all => "Algorithm::C3 required for this test" if $@; - plan tests => 4;use Class::MOP; require_ok(File::Spec->catfile('examples', 'C3MethodDispatchOrder.pod')); } { package Diamond_A; - use metaclass 'C3MethodDispatchOrder'; - + use metaclass 'C3MethodDispatchOrder'; + sub hello { 'Diamond_A::hello' } package Diamond_B; - use metaclass 'C3MethodDispatchOrder'; - __PACKAGE__->meta->superclasses('Diamond_A'); - + use metaclass 'C3MethodDispatchOrder'; + __PACKAGE__->meta->superclasses('Diamond_A'); + package Diamond_C; - use metaclass 'C3MethodDispatchOrder'; - __PACKAGE__->meta->superclasses('Diamond_A'); - + use metaclass 'C3MethodDispatchOrder'; + __PACKAGE__->meta->superclasses('Diamond_A'); + sub hello { 'Diamond_C::hello' } package Diamond_D; - use metaclass 'C3MethodDispatchOrder'; + use metaclass 'C3MethodDispatchOrder'; __PACKAGE__->meta->superclasses('Diamond_B', 'Diamond_C'); } @@ -40,4 +40,4 @@ is_deeply( is(Diamond_D->hello, 'Diamond_C::hello', '... got the right dispatch order'); is(Diamond_D->can('hello')->(), 'Diamond_C::hello', '... can(method) resolved itself as expected'); - +done_testing; diff --git a/t/108_ArrayBasedStorage_test.t b/t/108_ArrayBasedStorage_test.t index f47b010..58ff1d4 100644 --- a/t/108_ArrayBasedStorage_test.t +++ b/t/108_ArrayBasedStorage_test.t @@ -1,11 +1,12 @@ use strict; use warnings; -use Test::More tests => 72; +use Test::More; use File::Spec; use Scalar::Util 'reftype'; +use Class::MOP; -BEGIN {use Class::MOP; +BEGIN { require_ok(File::Spec->catfile('examples', 'ArrayBasedStorage.pod')); } @@ -200,3 +201,4 @@ my $new_baz = Bar::Baz->new; cmp_ok( scalar(@$new_baz), ">", scalar(@$baz), "additional slot due to refreshed meta instance" ); +done_testing; diff --git a/t/200_Class_C3_compatibility.t b/t/200_Class_C3_compatibility.t index 402fb8d..24afc9c 100644 --- a/t/200_Class_C3_compatibility.t +++ b/t/200_Class_C3_compatibility.t @@ -1,46 +1,45 @@ use strict; use warnings; -use Test::More tests => 7; +use Test::More; =pod -This tests that Class::MOP works correctly -with Class::C3 and it's somewhat insane +This tests that Class::MOP works correctly +with Class::C3 and it's somewhat insane approach to method resolution. =cut -BEGIN {use Class::MOP; -} +use Class::MOP; { package Diamond_A; use mro 'c3'; use metaclass; # everyone will just inherit this now :) - + sub hello { 'Diamond_A::hello' } } { package Diamond_B; - use mro 'c3'; + use mro 'c3'; use base 'Diamond_A'; } { package Diamond_C; use mro 'c3'; - use base 'Diamond_A'; - + use base 'Diamond_A'; + sub hello { 'Diamond_C::hello' } } { package Diamond_D; - use mro 'c3'; + use mro 'c3'; use base ('Diamond_B', 'Diamond_C'); } -# we have to manually initialize -# Class::C3 since we potentially +# we have to manually initialize +# Class::C3 since we potentially # skip this test if it is not present Class::C3::initialize(); @@ -61,3 +60,5 @@ SKIP: { ok(defined &Diamond_B::hello, '... B does have an alias to the method hello'); ok(defined &Diamond_D::hello, '... D does have an alias to the method hello'); } + +done_testing; diff --git a/t/300_random_eval_bug.t b/t/300_random_eval_bug.t index 497a698..1bf1cca 100644 --- a/t/300_random_eval_bug.t +++ b/t/300_random_eval_bug.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 1; +use Test::More; use Class::MOP; @@ -46,3 +46,5 @@ eval { $c->employees(); }; ok( $@, '... we die correctly with bad args' ); + +done_testing; diff --git a/t/301_RT_27329_fix.t b/t/301_RT_27329_fix.t index bfb0fe3..0c8ee6a 100644 --- a/t/301_RT_27329_fix.t +++ b/t/301_RT_27329_fix.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 8; +use Test::More; use Class::MOP; @@ -14,13 +14,13 @@ This tests a bug sent via RT #27329 { package Foo; use metaclass; - + Foo->meta->add_attribute('foo' => ( init_arg => 'foo', reader => 'get_foo', default => 'BAR', )); - + } my $foo = Foo->meta->new_object; @@ -32,7 +32,7 @@ is($foo->get_foo, 'BAR', '... got the right default value'); my $clone = $foo->meta->clone_object($foo, foo => 'BAZ'); isa_ok($clone, 'Foo'); isnt($clone, $foo, '... and it is a clone'); - + is($clone->get_foo, 'BAZ', '... got the right cloned value'); } @@ -40,12 +40,8 @@ is($foo->get_foo, 'BAR', '... got the right default value'); my $clone = $foo->meta->clone_object($foo, foo => undef); isa_ok($clone, 'Foo'); isnt($clone, $foo, '... and it is a clone'); - + ok(!defined($clone->get_foo), '... got the right cloned value'); } - - - - - +done_testing; diff --git a/t/302_modify_parent_method.t b/t/302_modify_parent_method.t index 734bcd4..c52f1a8 100644 --- a/t/302_modify_parent_method.t +++ b/t/302_modify_parent_method.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 4; +use Test::More; use Test::Exception; use Class::MOP; @@ -98,3 +98,4 @@ TODO: { ); } +done_testing; diff --git a/t/303_RT_39001_fix.t b/t/303_RT_39001_fix.t index f7e21e4..51e355e 100644 --- a/t/303_RT_39001_fix.t +++ b/t/303_RT_39001_fix.t @@ -1,6 +1,6 @@ use strict; use warnings; -use Test::More tests => 3; +use Test::More; use Test::Exception; use Class::MOP; @@ -33,3 +33,4 @@ throws_ok { Bar->meta->superclasses('Foo'); } qr/^Recursive inheritance detected/, "error occurs when Bar extends Foo, when Foo is a Bar"; +done_testing; diff --git a/t/304_constant_codeinfo.t b/t/304_constant_codeinfo.t index 2f15af2..b40cc82 100644 --- a/t/304_constant_codeinfo.t +++ b/t/304_constant_codeinfo.t @@ -1,6 +1,6 @@ use strict; use warnings; -use Test::More tests => 2; +use Test::More; use Class::MOP; @@ -18,3 +18,5 @@ undef $syms; $syms = $meta->get_all_package_symbols('CODE'); is(ref $syms->{FOO}, 'CODE', 'constant symbol still there, although we dropped our reference'); + +done_testing; diff --git a/t/305_RT_41255.t b/t/305_RT_41255.t index 8ecbbce..15e5c43 100644 --- a/t/305_RT_41255.t +++ b/t/305_RT_41255.t @@ -1,5 +1,5 @@ use strict; -use Test::More tests => 20; +use Test::More; use Test::Exception; use Class::MOP; @@ -47,3 +47,5 @@ while (my ($name, $meta_method) = each %methods) { is $meta_method->fully_qualified_name, "Derived::${name}"; lives_ok { $meta_method->execute }; } + +done_testing; diff --git a/t/306_rebless_overload.t b/t/306_rebless_overload.t index c431954..437ebb1 100644 --- a/t/306_rebless_overload.t +++ b/t/306_rebless_overload.t @@ -1,6 +1,6 @@ use strict; use warnings; -use Test::More tests => 3; +use Test::More; use Class::MOP; do { @@ -24,3 +24,4 @@ my $meta = Class::MOP::Class->initialize('With::Overloading'); $meta->rebless_instance($without); is("$without", "overloaded", "overloading after reblessing works"); +done_testing; diff --git a/t/307_null_stash.t b/t/307_null_stash.t index 3245287..9aa0ebc 100644 --- a/t/307_null_stash.t +++ b/t/307_null_stash.t @@ -1,10 +1,12 @@ #!/usr/bin/env perl use strict; use warnings; -use Test::More tests => 1; +use Test::More; use Class::MOP; my $non = Class::MOP::Class->initialize('Non::Existent::Package'); $non->get_method('foo'); pass("empty stashes don't segfault"); + +done_testing; diff --git a/t/308_insertion_order.t b/t/308_insertion_order.t index 9a66782..073d3b3 100644 --- a/t/308_insertion_order.t +++ b/t/308_insertion_order.t @@ -1,8 +1,8 @@ +use strict; +use warnings; +use Test::More; use Class::MOP; -use Test::More('tests', 2); - - my $Point = Class::MOP::Class->create('Point' => ( version => '0.01', attributes => [ @@ -13,7 +13,7 @@ my $Point = Class::MOP::Class->create('Point' => ( Class::MOP::Attribute->new('y' => ( accessor => 'y', init_arg => 'y' - )), + )), ], methods => { 'new' => sub { @@ -24,7 +24,7 @@ my $Point = Class::MOP::Class->create('Point' => ( 'clear' => sub { my $self = shift; $self->{'x'} = 0; - $self->{'y'} = 0; + $self->{'y'} = 0; } } )); @@ -32,4 +32,4 @@ my $Point = Class::MOP::Class->create('Point' => ( is($Point->get_attribute('x')->insertion_order, 0, 'Insertion order of Attribute "x"'); is($Point->get_attribute('y')->insertion_order, 1, 'Insertion order of Attribute "y"'); -1; +done_testing; diff --git a/t/309_subname.t b/t/309_subname.t index ea1fc53..6c113cc 100644 --- a/t/309_subname.t +++ b/t/309_subname.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 6; +use Test::More; use Class::MOP; @@ -38,3 +38,5 @@ is_deeply( is( Foo->bar, "Origin::bar", "caller aggrees" ); is( Origin->bar, "Origin::bar", "unrelated class untouched" ); + +done_testing; diff --git a/t/310_inline_structor.t b/t/310_inline_structor.t index 88aa7ad..8e1b055 100644 --- a/t/310_inline_structor.t +++ b/t/310_inline_structor.t @@ -6,7 +6,6 @@ use Test::More; BEGIN { eval "use Test::Output;"; plan skip_all => "Test::Output is required for this test" if $@; - plan tests => 15; } use Class::MOP; @@ -293,3 +292,5 @@ use Class::MOP; 'got a warning when trying to inline a destructor in a class that inherits an unexpected DESTROY' ); } + +done_testing; diff --git a/t/311_inline_and_dollar_at.t b/t/311_inline_and_dollar_at.t index c1fc286..80af4c9 100644 --- a/t/311_inline_and_dollar_at.t +++ b/t/311_inline_and_dollar_at.t @@ -1,10 +1,6 @@ use strict; use warnings; - use Test::More; - -plan tests => 1; - use Class::MOP; @@ -19,3 +15,5 @@ use Class::MOP; ::is( $@, 'dollar at', '$@ is untouched after immutablization' ); } + +done_testing; diff --git a/t/312_anon_class_leak.t b/t/312_anon_class_leak.t index 14ac2d3..46bcf7e 100644 --- a/t/312_anon_class_leak.t +++ b/t/312_anon_class_leak.t @@ -9,8 +9,6 @@ BEGIN { plan skip_all => "Test::LeakTrace is required for this test" if $@; } -plan tests => 2; - # 5.10.0 has a bug on weaken($hash_ref) which leaks an AV. my $expected = ( $] == 5.010_000 ? 1 : 0 ); @@ -24,3 +22,4 @@ leaks_cmp_ok { } '<=', $expected, 'create_anon_class(superclass => [...])'; +done_testing; diff --git a/t/313_before_after_dollar_under.t b/t/313_before_after_dollar_under.t index 003d9df..01d8da1 100644 --- a/t/313_before_after_dollar_under.t +++ b/t/313_before_after_dollar_under.t @@ -3,7 +3,7 @@ use warnings; use Class::MOP; use Class::MOP::Class; -use Test::More tests => 9; +use Test::More; use Test::Exception; my %results; @@ -68,3 +68,5 @@ for my $wrap (qw(before after)) { 'saw expected calls to wrappers' ); } + +done_testing; diff --git a/t/314_class_is_pristine.t b/t/314_class_is_pristine.t index 08e4b64..4ab95c0 100644 --- a/t/314_class_is_pristine.t +++ b/t/314_class_is_pristine.t @@ -2,8 +2,7 @@ use strict; use warnings; use Class::MOP; - -use Test::More tests => 3; +use Test::More; { package Foo; @@ -20,3 +19,5 @@ ok( $meta->is_pristine, 'Foo is still pristine after add_method' ); $meta->add_attribute( name => 'attr', reader => 'get_attr' ); ok( ! $meta->is_pristine, 'Foo is not pristine after add_attribute' ); + +done_testing; diff --git a/t/315_magic.t b/t/315_magic.t index d17dff0..2259d6a 100755 --- a/t/315_magic.t +++ b/t/315_magic.t @@ -4,7 +4,7 @@ use strict; use warnings; -use Test::More tests => 9; +use Test::More; use Test::Exception; use Class::MOP; @@ -15,14 +15,14 @@ use Tie::Scalar; package Foo; use metaclass; - Foo->meta->add_attribute('bar' => + Foo->meta->add_attribute('bar' => reader => 'get_bar', writer => 'set_bar', - ); + ); - Foo->meta->add_attribute('baz' => + Foo->meta->add_attribute('baz' => accessor => 'baz', - ); + ); Foo->meta->make_immutable(); } @@ -71,3 +71,5 @@ use Tie::Scalar; is_deeply [Class::MOP::get_code_info($value)], [qw(Class::MOP get_code_info)], 'get_code_info(tied scalar)'; } } + +done_testing; diff --git a/t/500_deprecated.t b/t/500_deprecated.t index 3f1337d..199c9ba 100755 --- a/t/500_deprecated.t +++ b/t/500_deprecated.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 7; +use Test::More; use Test::Exception; use Carp; @@ -82,3 +82,5 @@ $SIG{__WARN__} = \&croak; 'get_method_map returns expected methods' ); } + +done_testing;