use warnings;
use Test::More;
-use Test::Fatal;
+use Test::Exception;
use metaclass;
# 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");
'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";
}
'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
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");