X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F041_metaclass_incompatibility.t;h=5b0223f23af98edba36bfece8a21612f08b79df5;hb=8371f3de4e9525ab751008dca4a89e6df65345a6;hp=84c45a0978757b9da9a6f66bd1a11c9b96eff885;hpb=d65739b4429cbd77a5400b2ac8273af504fcf3da;p=gitmo%2FClass-MOP.git diff --git a/t/041_metaclass_incompatibility.t b/t/041_metaclass_incompatibility.t index 84c45a0..5b0223f 100644 --- a/t/041_metaclass_incompatibility.t +++ b/t/041_metaclass_incompatibility.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More; -use Test::Fatal; +use Test::Exception; use metaclass; @@ -32,79 +32,79 @@ for my $suffix ('Class', keys %metaclass_attrs) { # checking... -ok ! exception { +lives_ok { Foo::Meta::Class->create('Foo') -}, '... Foo.meta => Foo::Meta::Class is compatible'; -ok ! exception { +} '... Foo.meta => Foo::Meta::Class is compatible'; +lives_ok { Bar::Meta::Class->create('Bar') -}, '... Bar.meta => Bar::Meta::Class is compatible'; +} '... Bar.meta => Bar::Meta::Class is compatible'; -like exception { +throws_ok { Bar::Meta::Class->create('Foo::Foo', superclasses => ['Foo']) -}, qr/compatible/, '... Foo::Foo.meta => Bar::Meta::Class is not compatible'; -like exception { +} qr/compatible/, '... Foo::Foo.meta => Bar::Meta::Class is not compatible'; +throws_ok { Foo::Meta::Class->create('Bar::Bar', superclasses => ['Bar']) -}, qr/compatible/, '... Bar::Bar.meta => Foo::Meta::Class is not compatible'; +} qr/compatible/, '... Bar::Bar.meta => Foo::Meta::Class is not compatible'; -ok ! exception { +lives_ok { FooBar::Meta::Class->create('FooBar', superclasses => ['Foo']) -}, '... FooBar.meta => FooBar::Meta::Class is compatible'; -ok ! exception { +} '... FooBar.meta => FooBar::Meta::Class is compatible'; +lives_ok { FooBar::Meta::Class->create('FooBar2', superclasses => ['Bar']) -}, '... FooBar2.meta => FooBar::Meta::Class is compatible'; +} '... FooBar2.meta => FooBar::Meta::Class is compatible'; Foo::Meta::Class->create( 'Foo::All', map { $metaclass_attrs{$_} => "Foo::Meta::$_" } keys %metaclass_attrs, ); -like exception { +throws_ok { Bar::Meta::Class->create( 'Foo::All::Sub::Class', superclasses => ['Foo::All'], map { $metaclass_attrs{$_} => "Foo::Meta::$_" } keys %metaclass_attrs, ) -}, qr/compatible/, 'incompatible Class metaclass'; +} qr/compatible/, 'incompatible Class metaclass'; for my $suffix (keys %metaclass_attrs) { - like exception { + throws_ok { Foo::Meta::Class->create( "Foo::All::Sub::$suffix", superclasses => ['Foo::All'], (map { $metaclass_attrs{$_} => "Foo::Meta::$_" } keys %metaclass_attrs), $metaclass_attrs{$suffix} => "Bar::Meta::$suffix", ) - }, qr/compatible/, "incompatible $suffix metaclass"; + } qr/compatible/, "incompatible $suffix metaclass"; } # fixing... -ok ! exception { +lives_ok { Class::MOP::Class->create('Foo::Foo::CMOP', superclasses => ['Foo']) -}, 'metaclass fixing fixes a cmop metaclass, when the parent has a subclass'; +} 'metaclass fixing fixes a cmop metaclass, when the parent has a subclass'; isa_ok(Foo::Foo::CMOP->meta, 'Foo::Meta::Class'); -ok ! exception { +lives_ok { Class::MOP::Class->create('Bar::Bar::CMOP', superclasses => ['Bar']) -}, 'metaclass fixing fixes a cmop metaclass, when the parent has a subclass'; +} 'metaclass fixing fixes a cmop metaclass, when the parent has a subclass'; isa_ok(Bar::Bar::CMOP->meta, 'Bar::Meta::Class'); -ok ! exception { +lives_ok { Class::MOP::Class->create( 'Foo::All::Sub::CMOP::Class', superclasses => ['Foo::All'], map { $metaclass_attrs{$_} => "Foo::Meta::$_" } keys %metaclass_attrs, ) -}, 'metaclass fixing works with other non-default metaclasses'; +} 'metaclass fixing works with other non-default metaclasses'; isa_ok(Foo::All::Sub::CMOP::Class->meta, 'Foo::Meta::Class'); for my $suffix (keys %metaclass_attrs) { - ok ! exception { + lives_ok { Foo::Meta::Class->create( "Foo::All::Sub::CMOP::$suffix", superclasses => ['Foo::All'], (map { $metaclass_attrs{$_} => "Foo::Meta::$_" } keys %metaclass_attrs), $metaclass_attrs{$suffix} => "Class::MOP::$suffix", ) - }, "$metaclass_attrs{$suffix} fixing works with other non-default metaclasses"; + } "$metaclass_attrs{$suffix} fixing works with other non-default metaclasses"; for my $suffix2 (keys %metaclass_attrs) { my $method = $metaclass_attrs{$suffix2}; isa_ok("Foo::All::Sub::CMOP::$suffix"->meta->$method, "Foo::Meta::$suffix2"); @@ -188,7 +188,7 @@ isa_ok(Class::MOP::class_of('Foo::Reverse::Sub::Sub'), 'Foo::Meta::Class'); 'Foo::Unsafe::Sub', ); $meta->add_attribute(foo => reader => 'foo'); - like exception { $meta->superclasses('Foo::Unsafe') }, + throws_ok { $meta->superclasses('Foo::Unsafe') } qr/compatibility.*pristine/, "can't switch out the attribute metaclass of a class that already has attributes"; } @@ -207,11 +207,11 @@ isa_ok(Class::MOP::class_of('Foo::Reverse::Sub::Sub'), 'Foo::Meta::Class'); 'Baz::Mutable', ); $bazmeta->superclasses($foometa->name); - ok ! exception { $bazmeta->superclasses($barmeta->name) }, + lives_ok { $bazmeta->superclasses($barmeta->name) } "can still set superclasses"; ok(!$bazmeta->is_immutable, "immutable superclass doesn't make this class immutable"); - ok ! exception { $bazmeta->make_immutable }, "can still make immutable"; + lives_ok { $bazmeta->make_immutable } "can still make immutable"; } # nonexistent metaclasses @@ -221,37 +221,37 @@ Class::MOP::Class->create( superclasses => ['Class::MOP::Method'], ); -ok ! exception { +lives_ok { Class::MOP::Class->create( 'Weird::Class', destructor_class => 'Weird::Meta::Method::Destructor', ); -}, "defined metaclass in child with defined metaclass in parent is fine"; +} "defined metaclass in child with defined metaclass in parent is fine"; is(Weird::Class->meta->destructor_class, 'Weird::Meta::Method::Destructor', "got the right destructor class"); -ok ! exception { +lives_ok { Class::MOP::Class->create( 'Weird::Class::Sub', superclasses => ['Weird::Class'], destructor_class => undef, ); -}, "undef metaclass in child with defined metaclass in parent can be fixed"; +} "undef metaclass in child with defined metaclass in parent can be fixed"; is(Weird::Class::Sub->meta->destructor_class, 'Weird::Meta::Method::Destructor', "got the right destructor class"); -ok ! exception { +lives_ok { Class::MOP::Class->create( 'Weird::Class::Sub2', destructor_class => undef, ); -}, "undef metaclass in child with defined metaclass in parent can be fixed"; +} "undef metaclass in child with defined metaclass in parent can be fixed"; -ok ! exception { +lives_ok { Weird::Class::Sub2->meta->superclasses('Weird::Class'); -}, "undef metaclass in child with defined metaclass in parent can be fixed"; +} "undef metaclass in child with defined metaclass in parent can be fixed"; is(Weird::Class::Sub->meta->destructor_class, 'Weird::Meta::Method::Destructor', "got the right destructor class");