use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use Class::MOP::Class;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Scalar::Util qw/reftype/;
use Sub::Name;
ok( !UNIVERSAL::isa( $foo, 'Class::MOP::Method' ),
'... our method is not yet blessed' );
-lives_ok {
+is( exception {
$Foo->add_method( 'foo' => $foo );
-}
-'... we added the method successfully';
+}, undef, '... we added the method successfully' );
my $foo_method = $Foo->get_method('foo');
is( $Foo->remove_method('foo')->body, $foo, '... removed the foo method' );
ok( !$Foo->has_method('foo'),
'... !Foo->has_method(foo) we just removed it' );
-dies_ok { Foo->foo } '... cannot call Foo->foo because it is not there';
+isnt( exception { Foo->foo }, undef, '... cannot call Foo->foo because it is not there' );
is_deeply(
[ sort $Foo->get_method_list ],
is( Bar->foo, 'Bar::foo', '... Bar->foo == Bar::foo' );
is( Bar->bar, 'Bar::bar', '... Bar->bar == Bar::bar' );
-lives_ok {
+is( exception {
$Bar->add_method( 'foo' => sub {'Bar::foo v2'} );
-}
-'... overwriting a method is fine';
+}, undef, '... overwriting a method is fine' );
is_deeply( [ Class::MOP::get_code_info( $Bar->get_method('foo')->body ) ],
[ "Bar", "foo" ], "subname applied to anonymous method" );
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use Class::MOP::Class;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use metaclass;
my $meta = Foo->meta;
- ::lives_ok {
+ ::is( ::exception {
$meta->add_attribute($FOO_ATTR);
- } '... we added an attribute to Foo successfully';
+ }, undef, '... we added an attribute to Foo successfully' );
::ok($meta->has_attribute('$foo'), '... Foo has $foo attribute');
::is($meta->get_attribute('$foo'), $FOO_ATTR, '... got the right attribute back for Foo');
::ok(!$meta->has_method('foo'), '... no accessor created');
- ::lives_ok {
+ ::is( ::exception {
$meta->add_attribute($BAR_ATTR_2);
- } '... we added an attribute to Foo successfully';
+ }, undef, '... we added an attribute to Foo successfully' );
::ok($meta->has_attribute('$bar'), '... Foo has $bar attribute');
::is($meta->get_attribute('$bar'), $BAR_ATTR_2, '... got the right attribute back for Foo');
our @ISA = ('Foo');
my $meta = Bar->meta;
- ::lives_ok {
+ ::is( ::exception {
$meta->add_attribute($BAR_ATTR);
- } '... we added an attribute to Bar successfully';
+ }, undef, '... we added an attribute to Bar successfully' );
::ok($meta->has_attribute('$bar'), '... Bar has $bar attribute');
::is($meta->get_attribute('$bar'), $BAR_ATTR, '... got the right attribute back for Bar');
our @ISA = ('Bar');
my $meta = Baz->meta;
- ::lives_ok {
+ ::is( ::exception {
$meta->add_attribute($BAZ_ATTR);
- } '... we added an attribute to Baz successfully';
+ }, undef, '... we added an attribute to Baz successfully' );
::ok($meta->has_attribute('$baz'), '... Baz has $baz attribute');
::is($meta->get_attribute('$baz'), $BAZ_ATTR, '... got the right attribute back for Baz');
'... got the right list of associated classes from the applicable attributes for Baz');
my $attr;
- lives_ok {
+ is( exception {
$attr = $meta->remove_attribute('$baz');
- } '... removed the $baz attribute successfully';
+ }, undef, '... removed the $baz attribute successfully' );
is($attr, $BAZ_ATTR, '... got the right attribute back for Baz');
ok(!$meta->has_attribute('$baz'), '... Baz no longer has $baz attribute');
{
my $attr;
- lives_ok {
+ is( exception {
$attr = Bar->meta->remove_attribute('$bar');
- } '... removed the $bar attribute successfully';
+ }, undef, '... removed the $bar attribute successfully' );
is($attr, $BAR_ATTR, '... got the right attribute back for Bar');
ok(!Bar->meta->has_attribute('$bar'), '... Bar no longer has $bar attribute');
# remove attribute which is not there
my $val;
- lives_ok {
+ is( exception {
$val = $meta->remove_attribute('$blammo');
- } '... attempted to remove the non-existent $blammo attribute';
+ }, undef, '... attempted to remove the non-existent $blammo attribute' );
is($val, undef, '... got the right value back (undef)');
}
use Scalar::Util qw/blessed/;
my $meta = Buzz->meta;
- ::lives_ok {
+ ::is( ::exception {
$meta->add_attribute($FOO_ATTR_2);
- } '... we added an attribute to Buzz successfully';
+ }, undef, '... we added an attribute to Buzz successfully' );
- ::lives_ok {
+ ::is( ::exception {
$meta->add_attribute(
Class::MOP::Attribute->new(
'$bar' => (
)
)
);
- } '... we added an attribute to Buzz successfully';
+ }, undef, '... we added an attribute to Buzz successfully' );
- ::lives_ok {
+ ::is( ::exception {
$meta->add_attribute(
Class::MOP::Attribute->new(
'$bah' => (
)
)
);
- } '... we added an attribute to Buzz successfully';
+ }, undef, '... we added an attribute to Buzz successfully' );
- ::lives_ok {
+ ::is( ::exception {
$meta->add_method(build_foo => sub{ blessed shift; });
- } '... we added a method to Buzz successfully';
+ }, undef, '... we added a method to Buzz successfully' );
}
for(1 .. 2){
my $buzz;
- ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
+ ::is( ::exception { $buzz = Buzz->meta->new_object }, undef, '...Buzz instantiated successfully' );
::is($buzz->foo, 'Buzz', '...foo builder works as expected');
::ok(!$buzz->has_bar, '...bar is not set');
::is($buzz->bar, undef, '...bar returns undef');
::ok(!$buzz->has_bar, '...bar is no longerset');
my $buzz2;
- ::lives_ok { $buzz2 = Buzz->meta->new_object('$bar' => undef) } '...Buzz instantiated successfully';
+ ::is( ::exception { $buzz2 = Buzz->meta->new_object('$bar' => undef) }, undef, '...Buzz instantiated successfully' );
::ok($buzz2->has_bar, '...bar is set');
::is($buzz2->bar, undef, '...bar is undef');
my $buzz3;
- ::lives_ok { $buzz3 = Buzz->meta->new_object } '...Buzz instantiated successfully';
+ ::is( ::exception { $buzz3 = Buzz->meta->new_object }, undef, '...Buzz instantiated successfully' );
::ok($buzz3->has_bah, '...bah is set');
::is($buzz3->bah, 'BAH', '...bah returns "BAH" ');
my $buzz4;
- ::lives_ok { $buzz4 = Buzz->meta->new_object('$bah' => undef) } '...Buzz instantiated successfully';
+ ::is( ::exception { $buzz4 = Buzz->meta->new_object('$bah' => undef) }, undef, '...Buzz instantiated successfully' );
::ok($buzz4->has_bah, '...bah is set');
::is($buzz4->bah, undef, '...bah is undef');
use File::Spec::Functions;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
# check some errors
-dies_ok {
+isnt( exception {
$foo_meta->clone_object($meta);
-} '... this dies as expected';
+}, undef, '... this dies as expected' );
# test stuff
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use Class::MOP::Class;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
is($point->x, 2, '... the x attribute was initialized correctly through the metaobject');
-dies_ok {
+isnt( exception {
$point->x(42);
-} '... cannot write to a read-only accessor';
+}, undef, '... cannot write to a read-only accessor' );
is($point->x, 2, '... the x attribute was not altered');
$point->clear();
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet');
ok(!Foo->meta->has_package_symbol('%foo'), '... the meta agrees');
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('%foo' => { one => 1 });
-} '... created %Foo::foo successfully';
+}, undef, '... created %Foo::foo successfully' );
# ... scalar should NOT be created here
ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet');
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('@bar' => [ 1, 2, 3 ]);
-} '... created @Foo::bar successfully';
+}, undef, '... created @Foo::bar successfully' );
ok(defined($Foo::{bar}), '... the @bar slot was created successfully');
ok(Foo->meta->has_package_symbol('@bar'), '... the meta agrees');
ok(!defined($Foo::{baz}), '... the $baz slot has not been created yet');
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('$baz' => 10);
-} '... created $Foo::baz successfully';
+}, undef, '... created $Foo::baz successfully' );
ok(defined($Foo::{baz}), '... the $baz slot was created successfully');
ok(Foo->meta->has_package_symbol('$baz'), '... the meta agrees');
ok(!defined($Foo::{funk}), '... the &funk slot has not been created yet');
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('&funk' => sub { "Foo::funk" });
-} '... created &Foo::funk successfully';
+}, undef, '... created &Foo::funk successfully' );
ok(defined($Foo::{funk}), '... the &funk slot was created successfully');
ok(Foo->meta->has_package_symbol('&funk'), '... the meta agrees');
my $ARRAY = [ 1, 2, 3 ];
my $CODE = sub { "Foo::foo" };
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('@foo' => $ARRAY);
-} '... created @Foo::foo successfully';
+}, undef, '... created @Foo::foo successfully' );
ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot was added successfully');
is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('&foo' => $CODE);
-} '... created &Foo::foo successfully';
+}, undef, '... created &Foo::foo successfully' );
ok(Foo->meta->has_package_symbol('&foo'), '... the meta agrees');
is(Foo->meta->get_package_symbol('&foo'), $CODE, '... got the right value for &Foo::foo');
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('$foo' => 'Foo::foo');
-} '... created $Foo::foo successfully';
+}, undef, '... created $Foo::foo successfully' );
ok(Foo->meta->has_package_symbol('$foo'), '... the meta agrees');
my $SCALAR = Foo->meta->get_package_symbol('$foo');
is(${'Foo::foo'}, 'Foo::foo', '... got the right value from the scalar');
}
-lives_ok {
+is( exception {
Foo->meta->remove_package_symbol('%foo');
-} '... removed %Foo::foo successfully';
+}, undef, '... removed %Foo::foo successfully' );
ok(!Foo->meta->has_package_symbol('%foo'), '... the %foo slot was removed successfully');
ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');
ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed');
}
-lives_ok {
+is( exception {
Foo->meta->remove_package_symbol('&foo');
-} '... removed &Foo::foo successfully';
+}, undef, '... removed &Foo::foo successfully' );
ok(!Foo->meta->has_package_symbol('&foo'), '... the &foo slot no longer exists');
ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed');
}
-lives_ok {
+is( exception {
Foo->meta->remove_package_symbol('$foo');
-} '... removed $Foo::foo successfully';
+}, undef, '... removed $Foo::foo successfully' );
ok(!Foo->meta->has_package_symbol('$foo'), '... the $foo slot no longer exists');
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
is($point->x, 2, '... the x attribute was initialized correctly through the metaobject');
-dies_ok {
+isnt( exception {
$point->x(42);
-} '... cannot write to a read-only accessor';
+}, undef, '... cannot write to a read-only accessor' );
is($point->x, 2, '... the x attribute was not altered');
$point->clear();
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->initialize();
- } '... initialize requires a name parameter';
+ }, undef, '... initialize requires a name parameter' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->initialize('');
- } '... initialize requires a name valid parameter';
+ }, undef, '... initialize requires a name valid parameter' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->initialize(bless {} => 'Foo');
- } '... initialize requires an unblessed parameter'
+ }, undef, '... initialize requires an unblessed parameter' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->_construct_class_instance();
- } '... _construct_class_instance requires an :package parameter';
+ }, undef, '... _construct_class_instance requires an :package parameter' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->_construct_class_instance(':package' => undef);
- } '... _construct_class_instance requires a defined :package parameter';
+ }, undef, '... _construct_class_instance requires a defined :package parameter' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->_construct_class_instance(':package' => '');
- } '... _construct_class_instance requires a valid :package parameter';
+ }, undef, '... _construct_class_instance requires a valid :package parameter' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->create();
- } '... create requires an package_name parameter';
+ }, undef, '... create requires an package_name parameter' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->create(undef);
- } '... create requires a defined package_name parameter';
+ }, undef, '... create requires a defined package_name parameter' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->create('');
- } '... create requires a valid package_name parameter';
+ }, undef, '... create requires a valid package_name parameter' );
- throws_ok {
+ like( exception {
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' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->clone_object(1);
- } '... can only clone instances';
+ }, undef, '... can only clone instances' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->add_method();
- } '... add_method dies as expected';
+ }, undef, '... add_method dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->add_method('');
- } '... add_method dies as expected';
+ }, undef, '... add_method dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->add_method('foo' => 'foo');
- } '... add_method dies as expected';
+ }, undef, '... add_method dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->add_method('foo' => []);
- } '... add_method dies as expected';
+ }, undef, '... add_method dies as expected' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->has_method();
- } '... has_method dies as expected';
+ }, undef, '... has_method dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->has_method('');
- } '... has_method dies as expected';
+ }, undef, '... has_method dies as expected' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->get_method();
- } '... get_method dies as expected';
+ }, undef, '... get_method dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->get_method('');
- } '... get_method dies as expected';
+ }, undef, '... get_method dies as expected' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->remove_method();
- } '... remove_method dies as expected';
+ }, undef, '... remove_method dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->remove_method('');
- } '... remove_method dies as expected';
+ }, undef, '... remove_method dies as expected' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->find_all_methods_by_name();
- } '... find_all_methods_by_name dies as expected';
+ }, undef, '... find_all_methods_by_name dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->find_all_methods_by_name('');
- } '... find_all_methods_by_name dies as expected';
+ }, undef, '... find_all_methods_by_name dies as expected' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->add_attribute(bless {} => 'Foo');
- } '... add_attribute dies as expected';
+ }, undef, '... add_attribute dies as expected' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->has_attribute();
- } '... has_attribute dies as expected';
+ }, undef, '... has_attribute dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->has_attribute('');
- } '... has_attribute dies as expected';
+ }, undef, '... has_attribute dies as expected' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->get_attribute();
- } '... get_attribute dies as expected';
+ }, undef, '... get_attribute dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->get_attribute('');
- } '... get_attribute dies as expected';
+ }, undef, '... get_attribute dies as expected' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->remove_attribute();
- } '... remove_attribute dies as expected';
+ }, undef, '... remove_attribute dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->remove_attribute('');
- } '... remove_attribute dies as expected';
+ }, undef, '... remove_attribute dies as expected' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->add_package_symbol();
- } '... add_package_symbol dies as expected';
+ }, undef, '... add_package_symbol dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->add_package_symbol('');
- } '... add_package_symbol dies as expected';
+ }, undef, '... add_package_symbol dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->add_package_symbol('foo');
- } '... add_package_symbol dies as expected';
+ }, undef, '... add_package_symbol dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->add_package_symbol('&foo');
- } '... add_package_symbol dies as expected';
+ }, undef, '... add_package_symbol dies as expected' );
# throws_ok {
# Class::MOP::Class->meta->add_package_symbol('@-');
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->has_package_symbol();
- } '... has_package_symbol dies as expected';
+ }, undef, '... has_package_symbol dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->has_package_symbol('');
- } '... has_package_symbol dies as expected';
+ }, undef, '... has_package_symbol dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->has_package_symbol('foo');
- } '... has_package_symbol dies as expected';
+ }, undef, '... has_package_symbol dies as expected' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->get_package_symbol();
- } '... get_package_symbol dies as expected';
+ }, undef, '... get_package_symbol dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->get_package_symbol('');
- } '... get_package_symbol dies as expected';
+ }, undef, '... get_package_symbol dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->get_package_symbol('foo');
- } '... get_package_symbol dies as expected';
+ }, undef, '... get_package_symbol dies as expected' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Class->remove_package_symbol();
- } '... remove_package_symbol dies as expected';
+ }, undef, '... remove_package_symbol dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->remove_package_symbol('');
- } '... remove_package_symbol dies as expected';
+ }, undef, '... remove_package_symbol dies as expected' );
- dies_ok {
+ isnt( exception {
Class::MOP::Class->remove_package_symbol('foo');
- } '... remove_package_symbol dies as expected';
+ }, undef, '... remove_package_symbol dies as expected' );
}
done_testing;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
}
);
- ::throws_ok(
- sub {
- CheckingAccount->meta->add_before_method_modifier(
- 'does_not_exist' => sub { } );
- },
+ ::like(
+ ::exception{ CheckingAccount->meta->add_before_method_modifier(
+ 'does_not_exist' => sub { }
+ );
+ },
qr/\QThe method 'does_not_exist' was not found in the inheritance hierarchy for CheckingAccount/
);
isa_ok( $savings_account, 'BankAccount' );
is( $savings_account->balance, 250, '... got the right savings balance' );
-lives_ok {
+is( exception {
$savings_account->withdraw(50);
-}
-'... withdrew from savings successfully';
+}, undef, '... withdrew from savings successfully' );
is( $savings_account->balance, 200,
'... got the right savings balance after withdrawal' );
-dies_ok {
+isnt( exception {
$savings_account->withdraw(250);
-}
-'... could not withdraw from savings successfully';
+}, undef, '... could not withdraw from savings successfully' );
$savings_account->deposit(150);
is( $savings_account->balance, 350,
is( $checking_account->balance, 100, '... got the right checkings balance' );
-lives_ok {
+is( exception {
$checking_account->withdraw(50);
-}
-'... withdrew from checking successfully';
+}, undef, '... withdrew from checking successfully' );
is( $checking_account->balance, 50,
'... got the right checkings balance after withdrawal' );
is( $savings_account->balance, 350,
'... got the right savings balance after checking withdrawal (no overdraft)'
);
-lives_ok {
+is( exception {
$checking_account->withdraw(200);
-}
-'... withdrew from checking successfully';
+}, undef, '... withdrew from checking successfully' );
is( $checking_account->balance, 0,
'... got the right checkings balance after withdrawal' );
is( $savings_account->balance, 200,
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
[$anon_class->superclasses],
[],
'... got an empty superclass list');
- lives_ok {
+ is( exception {
$anon_class->superclasses('Foo');
- } '... can add a superclass to anon class';
+ }, undef, '... can add a superclass to anon class' );
is_deeply(
[$anon_class->superclasses],
[ 'Foo' ],
'... got the right superclass list');
ok(!$anon_class->has_method('foo'), '... no foo method');
- lives_ok {
+ is( exception {
$anon_class->add_method('foo' => sub { "__ANON__::foo" });
- } '... added a method to my anon-class';
+ }, undef, '... added a method to my anon-class' );
ok($anon_class->has_method('foo'), '... we have a foo method now');
$instance = $anon_class->new_object();
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use Scalar::Util 'reftype', 'blessed';
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use Class::MOP::Attribute;
use Class::MOP::Method;
-dies_ok { Class::MOP::Attribute->name } q{... can't call name() as a class method};
+isnt( exception { Class::MOP::Attribute->name }, undef, q{... can't call name() as a class method} );
{
my $class = Class::MOP::Class->initialize('Foo');
isa_ok($class, 'Class::MOP::Class');
- lives_ok {
+ is( exception {
$attr->attach_to_class($class);
- } '... attached a class successfully';
+ }, undef, '... attached a class successfully' );
is($attr->associated_class, $class, '... the class was associated correctly');
{
for my $value ({}, bless({}, 'Foo')) {
- throws_ok {
+ like( exception {
Class::MOP::Attribute->new('$foo', default => $value);
- } qr/References are not allowed as default values/;
+ }, qr/References are not allowed as default values/ );
}
}
{
my $attr;
- lives_ok {
+ is( exception {
my $meth = Class::MOP::Method->wrap(sub {shift}, name => 'foo', package_name => 'bar');
$attr = Class::MOP::Attribute->new('$foo', default => $meth);
- } 'Class::MOP::Methods accepted as default';
+ }, undef, 'Class::MOP::Methods accepted as default' );
is($attr->default(42), 42, 'passthrough for default on attribute');
}
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use Class::MOP::Attribute;
# most values are static
{
- dies_ok {
+ isnt( exception {
Class::MOP::Attribute->new('$test' => (
default => qr/hello (.*)/
));
- } '... no refs for defaults';
+ }, undef, '... no refs for defaults' );
- dies_ok {
+ isnt( exception {
Class::MOP::Attribute->new('$test' => (
default => []
));
- } '... no refs for defaults';
+ }, undef, '... no refs for defaults' );
- dies_ok {
+ isnt( exception {
Class::MOP::Attribute->new('$test' => (
default => {}
));
- } '... no refs for defaults';
+ }, undef, '... no refs for defaults' );
- dies_ok {
+ isnt( exception {
Class::MOP::Attribute->new('$test' => (
default => \(my $var)
));
- } '... no refs for defaults';
+ }, undef, '... no refs for defaults' );
- dies_ok {
+ isnt( exception {
Class::MOP::Attribute->new('$test' => (
default => bless {} => 'Foo'
));
- } '... no refs for defaults';
+ }, undef, '... no refs for defaults' );
}
{
- dies_ok {
+ isnt( exception {
Class::MOP::Attribute->new('$test' => (
builder => qr/hello (.*)/
));
- } '... no refs for builders';
+ }, undef, '... no refs for builders' );
- dies_ok {
+ isnt( exception {
Class::MOP::Attribute->new('$test' => (
builder => []
));
- } '... no refs for builders';
+ }, undef, '... no refs for builders' );
- dies_ok {
+ isnt( exception {
Class::MOP::Attribute->new('$test' => (
builder => {}
));
- } '... no refs for builders';
+ }, undef, '... no refs for builders' );
- dies_ok {
+ isnt( exception {
Class::MOP::Attribute->new('$test' => (
builder => \(my $var)
));
- } '... no refs for builders';
+ }, undef, '... no refs for builders' );
- dies_ok {
+ isnt( exception {
Class::MOP::Attribute->new('$test' => (
builder => bless {} => 'Foo'
));
- } '... no refs for builders';
+ }, undef, '... no refs for builders' );
- dies_ok {
+ isnt( exception {
Class::MOP::Attribute->new('$test' => (
builder => 'Foo', default => 'Foo'
));
- } '... no default AND builder';
+ }, undef, '... no default AND builder' );
my $undef_attr;
- lives_ok {
+ is( exception {
$undef_attr = Class::MOP::Attribute->new('$test' => (
default => undef,
predicate => 'has_test',
));
- } '... undef as a default is okay';
+ }, undef, '... undef as a default is okay' );
ok($undef_attr->has_default, '... and it counts as an actual default');
ok(!Class::MOP::Attribute->new('$test')->has_default,
'... but attributes with no default have no default');
ok($obj->has_test, '... and the default is populated');
is($obj->meta->get_attribute('$test')->get_value($obj), undef, '... with the right value');
}
- lives_ok { Foo->meta->make_immutable }
- '... and it can be inlined';
+ is( exception { Foo->meta->make_immutable }, undef, '... and it can be inlined' );
{
my $obj = Foo->new;
ok($obj->has_test, '... and the default is populated');
{ # bad construtor args
- dies_ok {
+ isnt( exception {
Class::MOP::Attribute->new();
- } '... no name argument';
+ }, undef, '... no name argument' );
# These are no longer errors
- lives_ok {
+ is( exception {
Class::MOP::Attribute->new('');
- } '... bad name argument';
+ }, undef, '... bad name argument' );
- lives_ok {
+ is( exception {
Class::MOP::Attribute->new(0);
- } '... bad name argument';
+ }, undef, '... bad name argument' );
}
{
my $attr = Class::MOP::Attribute->new('$test');
- dies_ok {
+ isnt( exception {
$attr->attach_to_class();
- } '... attach_to_class died as expected';
+ }, undef, '... attach_to_class died as expected' );
- dies_ok {
+ isnt( exception {
$attr->attach_to_class('Fail');
- } '... attach_to_class died as expected';
+ }, undef, '... attach_to_class died as expected' );
- dies_ok {
+ isnt( exception {
$attr->attach_to_class(bless {} => 'Fail');
- } '... attach_to_class died as expected';
+ }, undef, '... attach_to_class died as expected' );
}
{
$attr->attach_to_class(Class::MOP::Class->initialize('Foo'));
- dies_ok {
+ isnt( exception {
$attr->install_accessors;
- } '... bad reader format';
+ }, undef, '... bad reader format' );
}
{
my $attr = Class::MOP::Attribute->new('$test');
- dies_ok {
+ isnt( exception {
$attr->_process_accessors('fail', 'my_failing_sub');
- } '... cannot find "fail" type generator';
+ }, undef, '... cannot find "fail" type generator' );
}
reader => 'test'
));
- dies_ok {
+ isnt( exception {
$attr->install_accessors;
- } '... failed to generate accessors correctly';
+ }, undef, '... failed to generate accessors correctly' );
}
{
# it works, which is kinda silly, but it
# tests the API change, so I keep it.
- lives_ok {
+ is( exception {
Class::MOP::Attribute->new('$foo', (
accessor => 'foo',
reader => 'get_foo',
));
- } '... can create accessors with reader/writers';
+ }, undef, '... can create accessors with reader/writers' );
- lives_ok {
+ is( exception {
Class::MOP::Attribute->new('$foo', (
accessor => 'foo',
writer => 'set_foo',
));
- } '... can create accessors with reader/writers';
+ }, undef, '... can create accessors with reader/writers' );
- lives_ok {
+ is( exception {
Class::MOP::Attribute->new('$foo', (
accessor => 'foo',
reader => 'get_foo',
writer => 'set_foo',
));
- } '... can create accessors with reader/writers';
+ }, undef, '... can create accessors with reader/writers' );
}
done_testing;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use Class::MOP::Method;
'... the original_fully_qualified_name is the same as fully_qualified_name'
);
-dies_ok { Class::MOP::Method->wrap }
-q{... can't call wrap() without some code};
-dies_ok { Class::MOP::Method->wrap( [] ) }
-q{... can't call wrap() without some code};
-dies_ok { Class::MOP::Method->wrap( bless {} => 'Fail' ) }
-q{... can't call wrap() without some code};
-
-dies_ok { Class::MOP::Method->name }
-q{... can't call name() as a class method};
-dies_ok { Class::MOP::Method->body }
-q{... can't call body() as a class method};
-dies_ok { Class::MOP::Method->package_name }
-q{... can't call package_name() as a class method};
-dies_ok { Class::MOP::Method->fully_qualified_name }
-q{... can't call fully_qualified_name() as a class method};
+isnt( exception { Class::MOP::Method->wrap }, undef, q{... can't call wrap() without some code} );
+isnt( exception { Class::MOP::Method->wrap( [] ) }, undef, q{... can't call wrap() without some code} );
+isnt( exception { Class::MOP::Method->wrap( bless {} => 'Fail' ) }, undef, q{... can't call wrap() without some code} );
+
+isnt( exception { Class::MOP::Method->name }, undef, q{... can't call name() as a class method} );
+isnt( exception { Class::MOP::Method->body }, undef, q{... can't call body() as a class method} );
+isnt( exception { Class::MOP::Method->package_name }, undef, q{... can't call package_name() as a class method} );
+isnt( exception { Class::MOP::Method->fully_qualified_name }, undef, q{... can't call fully_qualified_name() as a class method} );
my $meta = Class::MOP::Method->meta;
isa_ok( $meta, 'Class::MOP::Class' );
'... our sub name is "' . $method_name . '"' );
}
-dies_ok {
+isnt( exception {
Class::MOP::Method->wrap();
-}
-'... bad args for &wrap';
+}, undef, '... bad args for &wrap' );
-dies_ok {
+isnt( exception {
Class::MOP::Method->wrap('Fail');
-}
-'... bad args for &wrap';
+}, undef, '... bad args for &wrap' );
-dies_ok {
+isnt( exception {
Class::MOP::Method->wrap( [] );
-}
-'... bad args for &wrap';
+}, undef, '... bad args for &wrap' );
-dies_ok {
+isnt( exception {
Class::MOP::Method->wrap( sub {'FAIL'} );
-}
-'... bad args for &wrap';
+}, undef, '... bad args for &wrap' );
-dies_ok {
+isnt( exception {
Class::MOP::Method->wrap( sub {'FAIL'}, package_name => 'main' );
-}
-'... bad args for &wrap';
+}, undef, '... bad args for &wrap' );
-dies_ok {
+isnt( exception {
Class::MOP::Method->wrap( sub {'FAIL'}, name => '__ANON__' );
-}
-'... bad args for &wrap';
+}, undef, '... bad args for &wrap' );
-lives_ok {
+is( exception {
Class::MOP::Method->wrap( bless( sub {'FAIL'}, "Foo" ),
name => '__ANON__', package_name => 'Foo::Bar' );
-}
-'... blessed coderef to &wrap';
+}, undef, '... blessed coderef to &wrap' );
my $clone = $method->clone(
package_name => 'NewPackage',
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use Class::MOP::Method;
'... got the right return value from the wrapped method' );
$trace = '';
- lives_ok {
+ is( exception {
$wrapped->add_before_modifier( sub { $trace .= 'before -> ' } );
- }
- '... added the before modifier okay';
+ }, undef, '... added the before modifier okay' );
$wrapped->();
is( $trace, 'before -> primary',
);
$trace = '';
- lives_ok {
+ is( exception {
$wrapped->add_after_modifier( sub { $trace .= ' -> after' } );
- }
- '... added the after modifier okay';
+ }, undef, '... added the after modifier okay' );
$wrapped->();
is( $trace, 'before -> primary -> after',
is( $wrapped->(), 4, '... got the right value from the wrapped method' );
- lives_ok {
+ is( exception {
$wrapped->add_around_modifier( sub { ( 3, $_[0]->() ) } );
$wrapped->add_around_modifier( sub { ( 2, $_[0]->() ) } );
$wrapped->add_around_modifier( sub { ( 1, $_[0]->() ) } );
$wrapped->add_around_modifier( sub { ( 0, $_[0]->() ) } );
- }
- '... added the around modifier okay';
+ }, undef, '... added the around modifier okay' );
is_deeply(
[ $wrapped->() ],
isa_ok( $wrapped, 'Class::MOP::Method::Wrapped' );
isa_ok( $wrapped, 'Class::MOP::Method' );
- lives_ok {
+ is( exception {
$wrapped->add_before_modifier( sub { push @tracelog => 'before 1' } );
$wrapped->add_before_modifier( sub { push @tracelog => 'before 2' } );
$wrapped->add_before_modifier( sub { push @tracelog => 'before 3' } );
- }
- '... added the before modifier okay';
+ }, undef, '... added the before modifier okay' );
- lives_ok {
+ is( exception {
$wrapped->add_around_modifier(
sub { push @tracelog => 'around 1'; $_[0]->(); } );
$wrapped->add_around_modifier(
sub { push @tracelog => 'around 2'; $_[0]->(); } );
$wrapped->add_around_modifier(
sub { push @tracelog => 'around 3'; $_[0]->(); } );
- }
- '... added the around modifier okay';
+ }, undef, '... added the around modifier okay' );
- lives_ok {
+ is( exception {
$wrapped->add_after_modifier( sub { push @tracelog => 'after 1' } );
$wrapped->add_after_modifier( sub { push @tracelog => 'after 2' } );
$wrapped->add_after_modifier( sub { push @tracelog => 'after 3' } );
- }
- '... added the after modifier okay';
+ }, undef, '... added the after modifier okay' );
$wrapped->();
is_deeply(
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use metaclass;
# checking...
-lives_ok {
+is( exception {
Foo::Meta::Class->create('Foo')
-} '... Foo.meta => Foo::Meta::Class is compatible';
-lives_ok {
+}, undef, '... Foo.meta => Foo::Meta::Class is compatible' );
+is( exception {
Bar::Meta::Class->create('Bar')
-} '... Bar.meta => Bar::Meta::Class is compatible';
+}, undef, '... Bar.meta => Bar::Meta::Class is compatible' );
-throws_ok {
+like( exception {
Bar::Meta::Class->create('Foo::Foo', superclasses => ['Foo'])
-} qr/compatible/, '... Foo::Foo.meta => Bar::Meta::Class is not compatible';
-throws_ok {
+}, qr/compatible/, '... Foo::Foo.meta => Bar::Meta::Class is not compatible' );
+like( exception {
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' );
-lives_ok {
+is( exception {
FooBar::Meta::Class->create('FooBar', superclasses => ['Foo'])
-} '... FooBar.meta => FooBar::Meta::Class is compatible';
-lives_ok {
+}, undef, '... FooBar.meta => FooBar::Meta::Class is compatible' );
+is( exception {
FooBar::Meta::Class->create('FooBar2', superclasses => ['Bar'])
-} '... FooBar2.meta => FooBar::Meta::Class is compatible';
+}, undef, '... FooBar2.meta => FooBar::Meta::Class is compatible' );
Foo::Meta::Class->create(
'Foo::All',
map { $metaclass_attrs{$_} => "Foo::Meta::$_" } keys %metaclass_attrs,
);
-throws_ok {
+like( exception {
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) {
- throws_ok {
+ like( exception {
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...
-lives_ok {
+is( exception {
Class::MOP::Class->create('Foo::Foo::CMOP', superclasses => ['Foo'])
-} 'metaclass fixing fixes a cmop metaclass, when the parent has a subclass';
+}, undef, 'metaclass fixing fixes a cmop metaclass, when the parent has a subclass' );
isa_ok(Foo::Foo::CMOP->meta, 'Foo::Meta::Class');
-lives_ok {
+is( exception {
Class::MOP::Class->create('Bar::Bar::CMOP', superclasses => ['Bar'])
-} 'metaclass fixing fixes a cmop metaclass, when the parent has a subclass';
+}, undef, 'metaclass fixing fixes a cmop metaclass, when the parent has a subclass' );
isa_ok(Bar::Bar::CMOP->meta, 'Bar::Meta::Class');
-lives_ok {
+is( exception {
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';
+}, undef, '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) {
- lives_ok {
+ is( exception {
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";
+ }, undef, "$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');
- throws_ok { $meta->superclasses('Foo::Unsafe') }
- qr/compatibility.*pristine/,
- "can't switch out the attribute metaclass of a class that already has attributes";
+ like( exception { $meta->superclasses('Foo::Unsafe') }, qr/compatibility.*pristine/, "can't switch out the attribute metaclass of a class that already has attributes" );
}
# immutability...
'Baz::Mutable',
);
$bazmeta->superclasses($foometa->name);
- lives_ok { $bazmeta->superclasses($barmeta->name) }
- "can still set superclasses";
+ is( exception { $bazmeta->superclasses($barmeta->name) }, undef, "can still set superclasses" );
ok(!$bazmeta->is_immutable,
"immutable superclass doesn't make this class immutable");
- lives_ok { $bazmeta->make_immutable } "can still make immutable";
+ is( exception { $bazmeta->make_immutable }, undef, "can still make immutable" );
}
# nonexistent metaclasses
superclasses => ['Class::MOP::Method'],
);
-lives_ok {
+is( exception {
Class::MOP::Class->create(
'Weird::Class',
destructor_class => 'Weird::Meta::Method::Destructor',
);
-} "defined metaclass in child with defined metaclass in parent is fine";
+}, undef, "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");
-lives_ok {
+is( exception {
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, "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");
-lives_ok {
+is( exception {
Class::MOP::Class->create(
'Weird::Class::Sub2',
destructor_class => undef,
);
-} "undef metaclass in child with defined metaclass in parent can be fixed";
+}, undef, "undef metaclass in child with defined metaclass in parent can be fixed" );
-lives_ok {
+is( exception {
Weird::Class::Sub2->meta->superclasses('Weird::Class');
-} "undef metaclass in child with defined metaclass in parent can be fixed";
+}, undef, "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");
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Scalar::Util 'blessed';
{
is(blessed($foo), 'Parent', 'Parent->new gives a Parent');
is($foo->whoami, "parent", 'Parent->whoami gives parent');
is($foo->parent, "parent", 'Parent->parent gives parent');
-dies_ok { $foo->child } "Parent->child method doesn't exist";
+isnt( exception { $foo->child }, undef, "Parent->child method doesn't exist" );
Child->meta->rebless_instance($foo);
is(blessed($foo), 'Child', 'rebless_instance really reblessed the instance');
is($foo->parent, "parent", 'reblessed->parent gives parent');
is($foo->child, "child", 'reblessed->child gives child');
-throws_ok { LeftField->meta->rebless_instance($foo) }
- qr/You may rebless only into a subclass of \(Child\), of which \(LeftField\) isn't\./;
+like( exception { LeftField->meta->rebless_instance($foo) }, qr/You may rebless only into a subclass of \(Child\), of which \(LeftField\) isn't\./ );
-throws_ok { Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo) }
- qr/You may rebless only into a subclass of \(Child\), of which \(NonExistent\) isn't\./;
+like( exception { Class::MOP::Class->initialize("NonExistent")->rebless_instance($foo) }, qr/You may rebless only into a subclass of \(Child\), of which \(NonExistent\) isn't\./ );
Parent->meta->rebless_instance_back($foo);
is(blessed($foo), 'Parent', 'Parent->new gives a Parent');
is($foo->whoami, "parent", 'Parent->whoami gives parent');
is($foo->parent, "parent", 'Parent->parent gives parent');
-dies_ok { $foo->child } "Parent->child method doesn't exist";
+isnt( exception { $foo->child }, undef, "Parent->child method doesn't exist" );
-throws_ok { LeftField->meta->rebless_instance_back($foo) }
- qr/You may rebless only into a superclass of \(Parent\), of which \(LeftField\) isn't\./;
+like( exception { LeftField->meta->rebless_instance_back($foo) }, qr/You may rebless only into a superclass of \(Parent\), of which \(LeftField\) isn't\./ );
-throws_ok { Class::MOP::Class->initialize("NonExistent")->rebless_instance_back($foo) }
- qr/You may rebless only into a superclass of \(Parent\), of which \(NonExistent\) isn't\./;
+like( exception { Class::MOP::Class->initialize("NonExistent")->rebless_instance_back($foo) }, qr/You may rebless only into a superclass of \(Parent\), of which \(NonExistent\) isn't\./ );
# make sure our ->meta is still sane
my $bar = Parent->new;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
is($foo->bar, 'BAR', '... got the expect value');
ok(!$foo->can('baz'), '... no baz method though');
- lives_ok {
+ is( exception {
Bar->meta->rebless_instance($foo)
- } '... this works';
+ }, undef, '... this works' );
is($foo->bar, 'BAR', '... got the expect value');
ok($foo->can('baz'), '... we have baz method now');
is($foo->baz, 'BAZ', '... got the expect value');
- lives_ok {
+ is( exception {
Foo->meta->rebless_instance_back($foo)
- } '... this works';
+ }, undef, '... this works' );
is($foo->bar, 'BAR', '... got the expect value');
ok(!$foo->can('baz'), '... no baz method though');
}
is($foo->bar, 'BAR', '... got the expect value');
ok(!$foo->can('baz'), '... no baz method though');
- lives_ok {
+ is( exception {
Bar->meta->rebless_instance($foo, (baz => 'FOO-BAZ'))
- } '... this works';
+ }, undef, '... this works' );
is($foo->bar, 'BAR', '... got the expect value');
ok($foo->can('baz'), '... we have baz method now');
is($foo->baz, 'FOO-BAZ', '... got the expect value');
- lives_ok {
+ is( exception {
Foo->meta->rebless_instance_back($foo)
- } '... this works';
+ }, undef, '... this works' );
is($foo->bar, 'BAR', '... got the expect value');
ok(!$foo->can('baz'), '... no baz method though');
is($foo->bar, 'BAR', '... got the expect value');
ok(!$foo->can('baz'), '... no baz method though');
- lives_ok {
+ is( exception {
Bar->meta->rebless_instance($foo, (bar => 'FOO-BAR', baz => 'FOO-BAZ'))
- } '... this works';
+ }, undef, '... this works' );
is($foo->bar, 'FOO-BAR', '... got the expect value');
ok($foo->can('baz'), '... we have baz method now');
is($foo->baz, 'FOO-BAZ', '... got the expect value');
- lives_ok {
+ is( exception {
Foo->meta->rebless_instance_back($foo)
- } '... this works';
+ }, undef, '... this works' );
is($foo->bar, 'FOO-BAR', '... got the expect value');
ok(!$foo->can('baz'), '... no baz method though');
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
ok(Class::MOP::class_of($meta_name), "metaclass still exists");
{
my $bar_meta;
- lives_ok {
+ is( exception {
$bar_meta = $meta_name->initialize('Bar');
- } "we can use the name on its own";
+ }, undef, "we can use the name on its own" );
isa_ok($bar_meta, $meta_name);
}
}
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
{
package Foo;
my $meta = Foo->meta;
check_meta_sanity($meta, 'Foo');
-lives_ok {
+is( exception {
$meta = $meta->reinitialize($meta->name);
-};
+}, undef );
check_meta_sanity($meta, 'Foo');
-lives_ok {
+is( exception {
$meta = $meta->reinitialize($meta);
-};
+}, undef );
check_meta_sanity($meta, 'Foo');
-throws_ok {
+like( exception {
$meta->reinitialize('');
-} qr/You must pass a package name or an existing Class::MOP::Package instance/;
+}, qr/You must pass a package name or an existing Class::MOP::Package instance/ );
-throws_ok {
+like( exception {
$meta->reinitialize($meta->new_object);
-} qr/You must pass a package name or an existing Class::MOP::Package instance/;
+}, qr/You must pass a package name or an existing Class::MOP::Package instance/ );
{
package Bar::Meta::Method;
check_meta_sanity($meta, 'Bar');
isa_ok(Bar->meta->get_method('foo'), 'Bar::Meta::Method');
isa_ok(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute');
-lives_ok {
+is( exception {
$meta = $meta->reinitialize('Bar');
-};
+}, undef );
check_meta_sanity($meta, 'Bar');
isa_ok(Bar->meta->get_method('foo'), 'Bar::Meta::Method');
isa_ok(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute');
is(Bar->meta->get_method('foo')->test, 'FOO');
is(Bar->meta->get_attribute('bar')->tset, 'OOF');
-lives_ok {
+is( exception {
$meta = $meta->reinitialize('Bar');
-};
+}, undef );
is(Bar->meta->get_method('foo')->test, 'FOO');
is(Bar->meta->get_attribute('bar')->tset, 'OOF');
check_meta_sanity($meta, 'Baz');
ok(!$meta->get_method('foo')->isa('Baz::Meta::Method'));
ok(!$meta->get_attribute('bar')->isa('Baz::Meta::Attribute'));
-lives_ok {
+is( exception {
$meta = $meta->reinitialize(
'Baz',
attribute_metaclass => 'Baz::Meta::Attribute',
method_metaclass => 'Baz::Meta::Method'
);
-};
+}, undef );
check_meta_sanity($meta, 'Baz');
isa_ok($meta->get_method('foo'), 'Baz::Meta::Method');
isa_ok($meta->get_attribute('bar'), 'Baz::Meta::Attribute');
check_meta_sanity($meta, 'Quux');
isa_ok(Quux->meta->get_method('foo'), 'Bar::Meta::Method');
isa_ok(Quux->meta->get_attribute('bar'), 'Bar::Meta::Attribute');
-throws_ok {
+like( exception {
$meta = $meta->reinitialize(
'Quux',
attribute_metaclass => 'Baz::Meta::Attribute',
method_metaclass => 'Baz::Meta::Method',
);
-} qr/compatible/;
+}, qr/compatible/ );
{
package Quuux::Meta::Attribute;
$meta = Quuux->meta;
check_meta_sanity($meta, 'Quuux');
ok($meta->has_method('bar'));
-lives_ok {
+is( exception {
$meta = $meta->reinitialize(
'Quuux',
attribute_metaclass => 'Quuux::Meta::Attribute',
);
-};
+}, undef );
check_meta_sanity($meta, 'Quuux');
ok(!$meta->has_method('bar'));
$meta = Class::MOP::class_of('Blah');
check_meta_sanity($meta, 'Blah');
-lives_ok {
+is( exception {
$meta = Class::MOP::Class->reinitialize(
'Blah',
attribute_metaclass => 'Blah::Meta::Attribute',
method_metaclass => 'Blah::Meta::Method',
);
-};
+}, undef );
check_meta_sanity($meta, 'Blah');
can_ok($meta->get_method('foo'), 'foo');
is($meta->get_method('foo')->foo, 'TEST');
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Scalar::Util qw/isweak reftype/;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP::Instance;
use strict;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
}
undef $instance;
-lives_and {
+is( exception {
my $foo = Foo::Sub->new;
isa_ok($foo, 'Foo');
isa_ok($foo, 'Foo::Sub');
is($foo, $instance, "used the passed-in instance");
-};
+}, undef );
undef $instance;
-lives_and {
+is( exception {
my $foo = Foo::Sub->new(foo => 'FOO');
isa_ok($foo, 'Foo');
isa_ok($foo, 'Foo::Sub');
is($foo, $instance, "used the passed-in instance");
is($foo->foo, 'FOO', "set non-CMOP constructor args");
-};
+}, undef );
undef $instance;
-lives_and {
+is( exception {
my $foo = Foo::Sub->new(bar => 'bar');
isa_ok($foo, 'Foo');
isa_ok($foo, 'Foo::Sub');
is($foo, $instance, "used the passed-in instance");
is($foo->bar, 'BAR', "set CMOP attributes");
-};
+}, undef );
undef $instance;
-lives_and {
+is( exception {
my $foo = Foo::Sub->new(foo => 'FOO', bar => 'bar');
isa_ok($foo, 'Foo');
isa_ok($foo, 'Foo::Sub');
is($foo, $instance, "used the passed-in instance");
is($foo->foo, 'FOO', "set non-CMOP constructor arg");
is($foo->bar, 'BAR', "set correct CMOP attribute");
-};
+}, undef );
{
package BadFoo;
);
}
-throws_ok { BadFoo::Sub->new }
- qr/BadFoo=HASH.*is not a BadFoo::Sub/,
- "error with incorrect constructors";
+like( exception { BadFoo::Sub->new }, qr/BadFoo=HASH.*is not a BadFoo::Sub/, "error with incorrect constructors" );
{
my $meta = Class::MOP::Class->create('Really::Bad::Foo');
- throws_ok {
+ like( exception {
$meta->new_object(__INSTANCE__ => (bless {}, 'Some::Other::Class'))
- } qr/Some::Other::Class=HASH.*is not a Really::Bad::Foo/,
- "error with completely invalid class";
+ }, qr/Some::Other::Class=HASH.*is not a Really::Bad::Foo/, "error with completely invalid class" );
}
{
my $meta = Class::MOP::Class->create('Really::Bad::Foo::2');
for my $invalid ('foo', 1, 0, '') {
- throws_ok {
+ like( exception {
$meta->new_object(__INSTANCE__ => $invalid)
- } qr/The __INSTANCE__ parameter must be a blessed reference, not $invalid/,
- "error with unblessed thing";
+ }, qr/The __INSTANCE__ parameter must be a blessed reference, not $invalid/, "error with unblessed thing" );
}
}
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
isa_ok( $meta, 'Class::MOP::Class' );
- dies_ok { $meta->add_method() } '... exception thrown as expected';
- dies_ok { $meta->alias_method() } '... exception thrown as expected';
- dies_ok { $meta->remove_method() } '... exception thrown as expected';
+ isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' );
- dies_ok { $meta->add_attribute() } '... exception thrown as expected';
- dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
+ isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' );
- dies_ok { $meta->add_package_symbol() }
- '... exception thrown as expected';
- dies_ok { $meta->remove_package_symbol() }
- '... exception thrown as expected';
+ isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' );
- lives_ok { $meta->identifier() }
- '... no exception for get_package_symbol special case';
+ is( exception { $meta->identifier() }, undef, '... no exception for get_package_symbol special case' );
my @supers;
- lives_ok {
+ is( exception {
@supers = $meta->superclasses;
- }
- '... got the superclasses okay';
+ }, undef, '... got the superclasses okay' );
- dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
- '... but could not set the superclasses okay';
+ isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' );
my $meta_instance;
- lives_ok {
+ is( exception {
$meta_instance = $meta->get_meta_instance;
- }
- '... got the meta instance okay';
+ }, undef, '... got the meta instance okay' );
isa_ok( $meta_instance, 'Class::MOP::Instance' );
is( $meta_instance, $meta->get_meta_instance,
'... and we know it is cached' );
my @cpl;
- lives_ok {
+ is( exception {
@cpl = $meta->class_precedence_list;
- }
- '... got the class precedence list okay';
+ }, undef, '... got the class precedence list okay' );
is_deeply(
\@cpl,
['Foo'],
);
my @attributes;
- lives_ok {
+ is( exception {
@attributes = $meta->get_all_attributes;
- }
- '... got the attribute list okay';
+ }, undef, '... got the attribute list okay' );
is_deeply(
\@attributes,
[ $meta->get_attribute('bar') ],
ok( $meta->is_mutable, '... our class is mutable' );
ok( !$meta->is_immutable, '... our class is not immutable' );
- lives_ok {
+ is( exception {
$meta->make_immutable();
- }
- '... changed Bar to be immutable';
+ }, undef, '... changed Bar to be immutable' );
ok( !$meta->make_immutable, '... make immutable now returns nothing' );
isa_ok( $meta, 'Class::MOP::Class' );
- dies_ok { $meta->add_method() } '... exception thrown as expected';
- dies_ok { $meta->alias_method() } '... exception thrown as expected';
- dies_ok { $meta->remove_method() } '... exception thrown as expected';
+ isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' );
- dies_ok { $meta->add_attribute() } '... exception thrown as expected';
- dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
+ isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' );
- dies_ok { $meta->add_package_symbol() }
- '... exception thrown as expected';
- dies_ok { $meta->remove_package_symbol() }
- '... exception thrown as expected';
+ isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' );
my @supers;
- lives_ok {
+ is( exception {
@supers = $meta->superclasses;
- }
- '... got the superclasses okay';
+ }, undef, '... got the superclasses okay' );
- dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
- '... but could not set the superclasses okay';
+ isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' );
my $meta_instance;
- lives_ok {
+ is( exception {
$meta_instance = $meta->get_meta_instance;
- }
- '... got the meta instance okay';
+ }, undef, '... got the meta instance okay' );
isa_ok( $meta_instance, 'Class::MOP::Instance' );
is( $meta_instance, $meta->get_meta_instance,
'... and we know it is cached' );
my @cpl;
- lives_ok {
+ is( exception {
@cpl = $meta->class_precedence_list;
- }
- '... got the class precedence list okay';
+ }, undef, '... got the class precedence list okay' );
is_deeply(
\@cpl,
[ 'Bar', 'Foo' ],
);
my @attributes;
- lives_ok {
+ is( exception {
@attributes = $meta->get_all_attributes;
- }
- '... got the attribute list okay';
+ }, undef, '... got the attribute list okay' );
is_deeply(
[ sort { $a->name cmp $b->name } @attributes ],
[ Foo->meta->get_attribute('bar'), $meta->get_attribute('baz') ],
ok( $meta->is_mutable, '... our class is mutable' );
ok( !$meta->is_immutable, '... our class is not immutable' );
- lives_ok {
+ is( exception {
$meta->make_immutable();
- }
- '... changed Baz to be immutable';
+ }, undef, '... changed Baz to be immutable' );
ok( !$meta->make_immutable, '... make immutable now returns nothing' );
isa_ok( $meta, 'Class::MOP::Class' );
- dies_ok { $meta->add_method() } '... exception thrown as expected';
- dies_ok { $meta->alias_method() } '... exception thrown as expected';
- dies_ok { $meta->remove_method() } '... exception thrown as expected';
+ isnt( exception { $meta->add_method() }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->alias_method() }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_method() }, undef, '... exception thrown as expected' );
- dies_ok { $meta->add_attribute() } '... exception thrown as expected';
- dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
+ isnt( exception { $meta->add_attribute() }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_attribute() }, undef, '... exception thrown as expected' );
- dies_ok { $meta->add_package_symbol() }
- '... exception thrown as expected';
- dies_ok { $meta->remove_package_symbol() }
- '... exception thrown as expected';
+ isnt( exception { $meta->add_package_symbol() }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_package_symbol() }, undef, '... exception thrown as expected' );
my @supers;
- lives_ok {
+ is( exception {
@supers = $meta->superclasses;
- }
- '... got the superclasses okay';
+ }, undef, '... got the superclasses okay' );
- dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
- '... but could not set the superclasses okay';
+ isnt( exception { $meta->superclasses( ['UNIVERSAL'] ) }, undef, '... but could not set the superclasses okay' );
my $meta_instance;
- lives_ok {
+ is( exception {
$meta_instance = $meta->get_meta_instance;
- }
- '... got the meta instance okay';
+ }, undef, '... got the meta instance okay' );
isa_ok( $meta_instance, 'Class::MOP::Instance' );
is( $meta_instance, $meta->get_meta_instance,
'... and we know it is cached' );
my @cpl;
- lives_ok {
+ is( exception {
@cpl = $meta->class_precedence_list;
- }
- '... got the class precedence list okay';
+ }, undef, '... got the class precedence list okay' );
is_deeply(
\@cpl,
[ 'Baz', 'Bar', 'Foo' ],
);
my @attributes;
- lives_ok {
+ is( exception {
@attributes = $meta->get_all_attributes;
- }
- '... got the attribute list okay';
+ }, undef, '... got the attribute list okay' );
is_deeply(
[ sort { $a->name cmp $b->name } @attributes ],
[
use File::Spec::Functions;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Scalar::Util;
use Class::MOP;
shift->meta->mymetaclass_attributes;
}
- ::lives_ok{ Baz->meta->superclasses('Bar') }
- '... we survive the metaclass incompatibility test';
+ ::is( ::exception { Baz->meta->superclasses('Bar') }, undef, '... we survive the metaclass incompatibility test' );
}
{
'... Baz can do method before immutable' );
ok( $meta->can('mymetaclass_attributes'),
'... meta can do method before immutable' );
- lives_ok { $meta->make_immutable } "Baz is now immutable";
+ is( exception { $meta->make_immutable }, undef, "Baz is now immutable" );
ok( $meta->is_immutable, '... Baz is immutable' );
isa_ok( $meta, 'MyMetaClass', 'Baz->meta' );
ok( Baz->can('mymetaclass_attributes'),
isnt( Scalar::Util::blessed( Baz->meta ),
Scalar::Util::blessed( Bar->meta ),
'Baz and Bar immutable metaclasses are different' );
- lives_ok { $meta->make_mutable } "Baz is now mutable";
+ is( exception { $meta->make_mutable }, undef, "Baz is now mutable" );
ok( $meta->is_mutable, '... Baz is mutable again' );
}
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
ok(!$meta->is_immutable, '... our class is not immutable');
- lives_ok {
+ is( exception {
$meta->make_immutable(
inline_constructor => 1,
inline_accessors => 0,
);
- } '... changed Foo to be immutable';
+ }, undef, '... changed Foo to be immutable' );
ok($meta->is_immutable, '... our class is now immutable');
isa_ok($meta, 'Class::MOP::Class');
ok(!$meta->is_immutable, '... our class is not immutable');
- lives_ok {
+ is( exception {
$meta->make_immutable(
inline_constructor => 1,
inline_accessors => 1,
);
- } '... changed Bar to be immutable';
+ }, undef, '... changed Bar to be immutable' );
ok($meta->is_immutable, '... our class is now immutable');
isa_ok($meta, 'Class::MOP::Class');
ok(!$meta->is_immutable, '... our class is not immutable');
- lives_ok {
+ is( exception {
$meta->make_immutable(
inline_constructor => 0,
inline_accessors => 1,
);
- } '... changed Bar to be immutable';
+ }, undef, '... changed Bar to be immutable' );
ok($meta->is_immutable, '... our class is now immutable');
isa_ok($meta, 'Class::MOP::Class');
{
my $buzz;
- ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
+ ::is( ::exception { $buzz = Buzz->meta->new_object }, undef, '...Buzz instantiated successfully' );
::ok(!$buzz->has_bar, '...bar is not set');
::is($buzz->bar, undef, '...bar returns undef');
::ok(!$buzz->has_bar, '...bar was not autovivified');
::ok(!$buzz->has_bar, '...bar is no longerset');
my $buzz2;
- ::lives_ok { $buzz2 = Buzz->meta->new_object('bar' => undef) } '...Buzz instantiated successfully';
+ ::is( ::exception { $buzz2 = Buzz->meta->new_object('bar' => undef) }, undef, '...Buzz instantiated successfully' );
::ok($buzz2->has_bar, '...bar is set');
::is($buzz2->bar, undef, '...bar is undef');
{
my $buzz;
- ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
+ ::is( ::exception { $buzz = Buzz->meta->new_object }, undef, '...Buzz instantiated successfully' );
::ok($buzz->has_bah, '...bah is set');
::is($buzz->bah, 'BAH', '...bah returns "BAH"' );
my $buzz2;
- ::lives_ok { $buzz2 = Buzz->meta->new_object('bah' => undef) } '...Buzz instantiated successfully';
+ ::is( ::exception { $buzz2 = Buzz->meta->new_object('bah' => undef) }, undef, '...Buzz instantiated successfully' );
::ok($buzz2->has_bah, '...bah is set');
::is($buzz2->bah, undef, '...bah is undef');
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Scalar::Util;
# Since this has no default it won't be present yet, but it will
# be after the class is made immutable.
- lives_ok {$meta->make_immutable; } '... changed Baz to be immutable';
+ is( exception {$meta->make_immutable; }, undef, '... changed Baz to be immutable' );
ok(!$meta->is_mutable, '... our class is no longer mutable');
ok($meta->is_immutable, '... our class is now immutable');
ok(!$meta->make_immutable, '... make immutable now returns nothing');
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';
+ is( exception { $meta->make_mutable; }, undef, '... changed Baz to be mutable' );
ok($meta->is_mutable, '... our class is mutable');
ok(!$meta->is_immutable, '... our class is not immutable');
ok(!$meta->make_mutable, '... make mutable now returns nothing');
my $reef = \ 'reef';
ok($meta->add_package_symbol('$ref', $reef), '... added package symbol');
is($meta->get_package_symbol('$ref'), $reef, '... values match');
- lives_ok { $meta->remove_package_symbol('$ref') } '... removed it';
+ is( exception { $meta->remove_package_symbol('$ref') }, undef, '... removed it' );
isnt($meta->get_package_symbol('$ref'), $reef, '... values match');
ok( my @supers = $meta->superclasses, '... got the superclasses okay');
for qw(get_meta_instance get_all_attributes
class_precedence_list );
- lives_ok {$meta->make_immutable; } '... changed Baz to be immutable again';
+ is( exception {$meta->make_immutable; }, undef, '... changed Baz to be immutable again' );
ok($meta->get_method('new'), '... inlined constructor recreated');
}
{
my $meta = Baz->meta;
- lives_ok { $meta->make_immutable() } 'Changed Baz to be immutable';
- lives_ok { $meta->make_mutable() } '... changed Baz to be mutable';
- lives_ok { $meta->make_immutable() } '... changed Baz to be immutable';
+ is( exception { $meta->make_immutable() }, undef, 'Changed Baz to be immutable' );
+ is( exception { $meta->make_mutable() }, undef, '... changed Baz to be mutable' );
+ is( exception { $meta->make_immutable() }, undef, '... changed Baz to be immutable' );
- dies_ok{ $meta->add_method('xyz', sub{'xxx'}) } '... exception thrown as expected';
+ isnt( exception { $meta->add_method('xyz', sub{'xxx'}) }, undef, '... exception thrown as expected' );
- dies_ok {
+ isnt( exception {
$meta->add_attribute('fickle', accessor => 'fickle')
- } '... exception thrown as expected';
- dies_ok { $meta->remove_attribute('fickle') } '... exception thrown as expected';
+ }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_attribute('fickle') }, undef, '... exception thrown as expected' );
my $reef = \ 'reef';
- dies_ok { $meta->add_package_symbol('$ref', $reef) } '... exception thrown as expected';
- dies_ok { $meta->remove_package_symbol('$ref') } '... exception thrown as expected';
+ isnt( exception { $meta->add_package_symbol('$ref', $reef) }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_package_symbol('$ref') }, undef, '... exception thrown as expected' );
ok( my @supers = $meta->superclasses, '... got the superclasses okay');
- dies_ok { $meta->superclasses('Foo') } '... set the superclasses';
+ isnt( exception { $meta->superclasses('Foo') }, undef, '... set the superclasses' );
ok( $meta->$_ , "... ${_} works")
for qw(get_meta_instance get_all_attributes
ok($meta->is_mutable, '... our anon class is mutable');
ok(!$meta->is_immutable, '... our anon class is not immutable');
- lives_ok {$meta->make_immutable(
+ is( exception {$meta->make_immutable(
inline_accessor => 1,
inline_destructor => 0,
inline_constructor => 1,
)
- } '... changed class to be immutable';
+ }, undef, '... changed class to be immutable' );
ok(!$meta->is_mutable, '... our class is no longer mutable');
ok($meta->is_immutable, '... our class is now immutable');
ok(!$meta->make_immutable, '... make immutable now returns nothing');
- lives_ok { $meta->make_mutable } '... changed Baz to be mutable';
+ is( exception { $meta->make_mutable }, undef, '... changed Baz to be mutable' );
ok($meta->is_mutable, '... our class is mutable');
ok(!$meta->is_immutable, '... our class is not immutable');
ok(!$meta->make_mutable, '... make mutable now returns nothing');
my $reef = \ 'reef';
ok($meta->add_package_symbol('$ref', $reef), '... added package symbol');
is($meta->get_package_symbol('$ref'), $reef, '... values match');
- lives_ok { $meta->remove_package_symbol('$ref') } '... removed it';
+ is( exception { $meta->remove_package_symbol('$ref') }, undef, '... removed it' );
isnt($meta->get_package_symbol('$ref'), $reef, '... values match');
ok( my @supers = $meta->superclasses, '... got the superclasses okay');
{
my $meta = Baz->meta->create_anon_class(superclasses => ['Baz']);
- lives_ok {$meta->make_immutable(
+ is( exception {$meta->make_immutable(
inline_accessor => 1,
inline_destructor => 0,
inline_constructor => 1,
)
- } '... changed class to be immutable';
- lives_ok { $meta->make_mutable() } '... changed class to be mutable';
- lives_ok {$meta->make_immutable } '... changed class to be immutable';
+ }, undef, '... changed class to be immutable' );
+ is( exception { $meta->make_mutable() }, undef, '... changed class to be mutable' );
+ is( exception {$meta->make_immutable }, undef, '... changed class to be immutable' );
- dies_ok{ $meta->add_method('xyz', sub{'xxx'}) } '... exception thrown as expected';
+ isnt( exception { $meta->add_method('xyz', sub{'xxx'}) }, undef, '... exception thrown as expected' );
- dies_ok {
+ isnt( exception {
$meta->add_attribute('fickle', accessor => 'fickle')
- } '... exception thrown as expected';
- dies_ok { $meta->remove_attribute('fickle') } '... exception thrown as expected';
+ }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_attribute('fickle') }, undef, '... exception thrown as expected' );
my $reef = \ 'reef';
- dies_ok { $meta->add_package_symbol('$ref', $reef) } '... exception thrown as expected';
- dies_ok { $meta->remove_package_symbol('$ref') } '... exception thrown as expected';
+ isnt( exception { $meta->add_package_symbol('$ref', $reef) }, undef, '... exception thrown as expected' );
+ isnt( exception { $meta->remove_package_symbol('$ref') }, undef, '... exception thrown as expected' );
ok( my @supers = $meta->superclasses, '... got the superclasses okay');
- dies_ok { $meta->superclasses('Foo') } '... set the superclasses';
+ isnt( exception { $meta->superclasses('Foo') }, undef, '... set the superclasses' );
ok( $meta->$_ , "... ${_} works")
for qw(get_meta_instance get_all_attributes
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
__PACKAGE__->meta->add_attribute('bar');
- ::lives_ok { __PACKAGE__->meta->make_immutable }
- 'can safely make a class immutable when it has a custom metaclass and immutable trait';
+ ::is( ::exception { __PACKAGE__->meta->make_immutable }, undef, 'can safely make a class immutable when it has a custom metaclass and immutable trait' );
}
{
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use Class::MOP::Package;
-dies_ok { Class::MOP::Package->get_all_package_symbols } q{... can't call get_all_package_symbols() as a class method};
-dies_ok { Class::MOP::Package->name } q{... can't call name() as a class method};
+isnt( exception { Class::MOP::Package->get_all_package_symbols }, undef, q{... can't call get_all_package_symbols() as a class method} );
+isnt( exception { Class::MOP::Package->name }, undef, q{... can't call name() as a class method} );
{
package Foo;
ok(!Foo->meta->has_package_symbol('%foo'), '... the meta agrees');
ok(!defined($Foo::{foo}), '... checking doesn\' vivify');
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('%foo' => { one => 1 });
-} '... created %Foo::foo successfully';
+}, undef, '... created %Foo::foo successfully' );
# ... scalar should NOT be created here
ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet');
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('@bar' => [ 1, 2, 3 ]);
-} '... created @Foo::bar successfully';
+}, undef, '... created @Foo::bar successfully' );
ok(defined($Foo::{bar}), '... the @bar slot was created successfully');
ok(Foo->meta->has_package_symbol('@bar'), '... the meta agrees');
ok(!defined($Foo::{baz}), '... the $baz slot has not been created yet');
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('$baz' => 10);
-} '... created $Foo::baz successfully';
+}, undef, '... created $Foo::baz successfully' );
ok(defined($Foo::{baz}), '... the $baz slot was created successfully');
ok(Foo->meta->has_package_symbol('$baz'), '... the meta agrees');
ok(!defined($Foo::{funk}), '... the &funk slot has not been created yet');
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('&funk' => sub { "Foo::funk" });
-} '... created &Foo::funk successfully';
+}, undef, '... created &Foo::funk successfully' );
ok(defined($Foo::{funk}), '... the &funk slot was created successfully');
ok(Foo->meta->has_package_symbol('&funk'), '... the meta agrees');
my $ARRAY = [ 1, 2, 3 ];
my $CODE = sub { "Foo::foo" };
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('@foo' => $ARRAY);
-} '... created @Foo::foo successfully';
+}, undef, '... created @Foo::foo successfully' );
ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot was added successfully');
is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('&foo' => $CODE);
-} '... created &Foo::foo successfully';
+}, undef, '... created &Foo::foo successfully' );
ok(Foo->meta->has_package_symbol('&foo'), '... the meta agrees');
is(Foo->meta->get_package_symbol('&foo'), $CODE, '... got the right value for &Foo::foo');
-lives_ok {
+is( exception {
Foo->meta->add_package_symbol('$foo' => 'Foo::foo');
-} '... created $Foo::foo successfully';
+}, undef, '... created $Foo::foo successfully' );
ok(Foo->meta->has_package_symbol('$foo'), '... the meta agrees');
my $SCALAR = Foo->meta->get_package_symbol('$foo');
is(${'Foo::foo'}, 'Foo::foo', '... got the right value from the scalar');
}
-lives_ok {
+is( exception {
Foo->meta->remove_package_symbol('%foo');
-} '... removed %Foo::foo successfully';
+}, undef, '... removed %Foo::foo successfully' );
ok(!Foo->meta->has_package_symbol('%foo'), '... the %foo slot was removed successfully');
ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');
ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed');
}
-lives_ok {
+is( exception {
Foo->meta->remove_package_symbol('&foo');
-} '... removed &Foo::foo successfully';
+}, undef, '... removed &Foo::foo successfully' );
ok(!Foo->meta->has_package_symbol('&foo'), '... the &foo slot no longer exists');
ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed');
}
-lives_ok {
+is( exception {
Foo->meta->remove_package_symbol('$foo');
-} '... removed $Foo::foo successfully';
+}, undef, '... removed $Foo::foo successfully' );
ok(!Foo->meta->has_package_symbol('$foo'), '... the $foo slot no longer exists');
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet');
ok(!$meta->has_package_symbol('%foo'), '... the meta agrees');
-lives_ok {
+is( exception {
$meta->add_package_symbol('%foo' => { one => 1 });
-} '... the %foo symbol is created succcessfully';
+}, undef, '... the %foo symbol is created succcessfully' );
ok(!defined($Foo::{foo}), '... the %foo slot has not been created in the actual Foo package');
ok($meta->has_package_symbol('%foo'), '... the meta agrees');
ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet');
-lives_ok {
+is( exception {
$meta->add_package_symbol('@bar' => [ 1, 2, 3 ]);
-} '... created @Foo::bar successfully';
+}, undef, '... created @Foo::bar successfully' );
ok(!defined($Foo::{bar}), '... the @bar slot has still not been created');
ok(!defined($Foo::{baz}), '... the %baz slot has not been created yet');
-lives_ok {
+is( exception {
$meta->add_package_symbol('%baz');
-} '... created %Foo::baz successfully';
+}, undef, '... created %Foo::baz successfully' );
ok(!defined($Foo::{baz}), '... the %baz slot has still not been created');
use strict;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
require Class::MOP;
use lib 't/lib';
-dies_ok {
+isnt( exception {
Class::MOP::is_class_loaded()
-} "is_class_loaded with no argument dies";
+}, undef, "is_class_loaded with no argument dies" );
ok(!Class::MOP::is_class_loaded(''), "can't load the empty class");
ok(!Class::MOP::is_class_loaded(\"foo"), "can't load a class name reference??");
ok(Class::MOP::_is_valid_class_name('Foo'), q{'Foo' is a valid class name});
ok(Class::MOP::_is_valid_class_name('Foo::Bar'), q{'Foo::Bar' is a valid class name});
ok(Class::MOP::_is_valid_class_name('Foo_::Bar2'), q{'Foo_::Bar2' is a valid class name});
-throws_ok { Class::MOP::load_class('bogus name') } qr/Invalid class name \(bogus name\)/;
+like( exception { Class::MOP::load_class('bogus name') }, qr/Invalid class name \(bogus name\)/ );
-throws_ok {
+like( exception {
Class::MOP::load_class('__PACKAGE__')
-} qr/__PACKAGE__\.pm.*\@INC/, 'errors sanely on __PACKAGE__.pm';
+}, qr/__PACKAGE__\.pm.*\@INC/, 'errors sanely on __PACKAGE__.pm' );
Class::MOP::load_class('BinaryTree');
can_ok('BinaryTree' => 'traverse');
ok( !Class::MOP::does_metaclass_exist("Class"), "no metaclass for non MOP class" );
-throws_ok {
+like( exception {
Class::MOP::load_class('FakeClassOhNo');
-}
-qr/Can't locate /;
+}, qr/Can't locate / );
-throws_ok {
+like( exception {
Class::MOP::load_class('SyntaxError');
-}
-qr/Missing right curly/;
+}, qr/Missing right curly/ );
-throws_ok {
+like( exception {
delete $INC{'SyntaxError.pm'};
Class::MOP::load_first_existing_class(
'FakeClassOhNo', 'SyntaxError', 'Class'
);
-}
-qr/Missing right curly/,
- 'load_first_existing_class does not pass over an existing (bad) module';
+}, qr/Missing right curly/, 'load_first_existing_class does not pass over an existing (bad) module' );
-throws_ok {
+like( exception {
Class::MOP::load_class('This::Does::Not::Exist');
-}
-qr{Can't locate This/Does/Not/Exist\.pm in \@INC},
- 'load_first_existing_class throws a familiar error for a single module';
+}, qr{Can't locate This/Does/Not/Exist\.pm in \@INC}, 'load_first_existing_class throws a familiar error for a single module' );
{
package Other;
use constant foo => "bar";
}
-lives_ok {
+is( exception {
ok(Class::MOP::is_class_loaded("Other"), 'is_class_loaded(Other)');
-}
-"a class with just constants is still a class";
+}, undef, "a class with just constants is still a class" );
{
package Lala;
use metaclass;
}
-lives_ok {
+is( exception {
is(Class::MOP::load_first_existing_class("Lala", "Does::Not::Exist"), "Lala", 'load_first_existing_class 1/2 params ok, class name returned');
is(Class::MOP::load_first_existing_class("Does::Not::Exist", "Lala"), "Lala", 'load_first_existing_class 2/2 params ok, class name returned');
-} 'load_classes works';
+}, undef, 'load_classes works' );
-throws_ok {
+like( exception {
Class::MOP::load_first_existing_class("Does::Not::Exist", "Also::Does::Not::Exist")
-} qr/Does::Not::Exist.*Also::Does::Not::Exist/s, 'Multiple non-existant classes cause exception';
+}, qr/Does::Not::Exist.*Also::Does::Not::Exist/s, 'Multiple non-existant classes cause exception' );
{
sub whatever {
ok( !Class::MOP::is_class_loaded('Class::WithVersion', { -version => 42 }),
'version 23 does not satisfy version requirement 42' );
- throws_ok {
+ like( exception {
Class::MOP::load_first_existing_class('Affe', 'Tiger', 'Class::WithVersion' => { -version => 42 });
- } qr/Class::WithVersion version 42 required--this is only version 23/,
- 'load_first_existing_class gives correct exception on old version';
+ }, qr/Class::WithVersion version 42 required--this is only version 23/, 'load_first_existing_class gives correct exception on old version' );
- lives_ok {
+ is( exception {
Class::MOP::load_first_existing_class('Affe', 'Tiger', 'Class::WithVersion' => { -version => 13 });
- } 'loading class with required version with load_first_existing_class';
+ }, undef, 'loading class with required version with load_first_existing_class' );
- throws_ok {
+ like( exception {
Class::MOP::load_class('Class::WithVersion' => { -version => 42 });
- } qr/Class::WithVersion version 42 required--this is only version 23/,
- 'load_class gives correct exception on old version';
+ }, qr/Class::WithVersion version 42 required--this is only version 23/, 'load_class gives correct exception on old version' );
- lives_ok {
+ is( exception {
Class::MOP::load_class('Class::WithVersion' => { -version => 13 });
- } 'loading class with required version with load_class';
+ }, undef, 'loading class with required version with load_class' );
}
use strict;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use lib 't/lib';
-lives_ok {
+is( exception {
Class::MOP::load_class('TestClassLoaded::Sub');
-};
+}, undef );
TestClassLoaded->can('a_method');
-lives_ok {
+is( exception {
Class::MOP::load_class('TestClassLoaded');
-};
+}, undef );
-lives_ok {
+is( exception {
TestClassLoaded->a_method;
-};
+}, undef );
done_testing;
use strict;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
{
my $meta = Class::MOP::class_of('Foo');
ok(!$meta->has_method('meta'), "no meta method was installed");
$meta->add_method(meta => sub { die 'META' });
- lives_ok { $meta->find_method_by_name('meta') } "can do meta-level stuff";
- lives_ok { $meta->make_immutable } "can do meta-level stuff";
- lives_ok { $meta->class_precedence_list } "can do meta-level stuff";
+ is( exception { $meta->find_method_by_name('meta') }, undef, "can do meta-level stuff" );
+ is( exception { $meta->make_immutable }, undef, "can do meta-level stuff" );
+ is( exception { $meta->class_precedence_list }, undef, "can do meta-level stuff" );
}
{
my $meta = Class::MOP::Class->create('Bar', meta_name => undef);
ok(!$meta->has_method('meta'), "no meta method was installed");
$meta->add_method(meta => sub { die 'META' });
- lives_ok { $meta->find_method_by_name('meta') } "can do meta-level stuff";
- lives_ok { $meta->make_immutable } "can do meta-level stuff";
- lives_ok { $meta->class_precedence_list } "can do meta-level stuff";
+ is( exception { $meta->find_method_by_name('meta') }, undef, "can do meta-level stuff" );
+ is( exception { $meta->make_immutable }, undef, "can do meta-level stuff" );
+ is( exception { $meta->class_precedence_list }, undef, "can do meta-level stuff" );
}
done_testing;
use File::Spec::Functions;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
ok(!Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is not loaded');
-lives_ok {
+is( exception {
Class::MOP::load_class('BinaryTree');
-} '... loaded the BinaryTree class without dying';
+}, undef, '... loaded the BinaryTree class without dying' );
ok(Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is now loaded');
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use strict;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
use metaclass;
}
-throws_ok {
+like( exception {
Foo->meta->superclasses('Foo');
-} qr/^Recursive inheritance detected/, "error occurs when extending oneself";
+}, qr/^Recursive inheritance detected/, "error occurs when extending oneself" );
{
package Bar;
# if DEBUG_NO_META is set)
@Foo::ISA = ();
-lives_ok {
+is( exception {
Foo->meta->superclasses('Bar');
-} "regular subclass";
+}, undef, "regular subclass" );
-throws_ok {
+like( exception {
Bar->meta->superclasses('Foo');
-} qr/^Recursive inheritance detected/, "error occurs when Bar extends Foo, when Foo is a Bar";
+}, qr/^Recursive inheritance detected/, "error occurs when Bar extends Foo, when Foo is a Bar" );
done_testing;
use strict;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
while (my ($name, $meta_method) = each %methods) {
is $meta_method->fully_qualified_name, "Derived::${name}";
- throws_ok { $meta_method->execute } qr/Undefined subroutine .* called at/;
+ like( exception { $meta_method->execute }, qr/Undefined subroutine .* called at/ );
}
{
while (my ($name, $meta_method) = each %methods) {
is $meta_method->fully_qualified_name, "Derived::${name}";
- lives_ok { $meta_method->execute };
+ is( exception { $meta_method->execute }, undef );
}
done_testing;
use Class::MOP;
use Class::MOP::Class;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
my %results;
%results = ();
my $o = $meta->get_meta_instance->create_instance;
isa_ok( $o, 'Base' );
- lives_ok {
+ is( exception {
$o->hey;
$o->hey
; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
- }
- 'wrapped doesn\'t die when $_ gets changed';
+ }, undef, 'wrapped doesn\'t die when $_ gets changed' );
is_deeply(
\%results, { base => 2, wrapped => 2 },
'saw expected calls to wrappers'
%results = ();
my $o = $meta->get_meta_instance->create_instance;
isa_ok( $o, 'Base' );
- lives_ok {
+ is( exception {
$o->hey;
$o->hey
; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
- }
- 'double-wrapped doesn\'t die when $_ gets changed';
+ }, undef, 'double-wrapped doesn\'t die when $_ gets changed' );
is_deeply(
\%results, { base => 2, wrapped => 4 },
'saw expected calls to wrappers'
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
{
my $x = tie my $value, 'Tie::StdScalar', 'Class::MOP';
- lives_ok{ Class::MOP::load_class($value) } 'load_class(tied scalar)';
+ is( exception { Class::MOP::load_class($value) }, undef, 'load_class(tied scalar)' );
$value = undef;
$x->STORE('Class::MOP'); # reset
- lives_and{
+ is( exception {
ok Class::MOP::is_class_loaded($value);
- } 'is_class_loaded(tied scalar)';
+ }, undef, 'is_class_loaded(tied scalar)' );
$value = undef;
$x->STORE(\&Class::MOP::get_code_info); # reset
- lives_and{
+ is( exception {
is_deeply [Class::MOP::get_code_info($value)], [qw(Class::MOP get_code_info)], 'get_code_info(tied scalar)';
- }
+ }, undef );
}
done_testing;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Carp;
{
package Foo;
- ::throws_ok{
+ ::like( ::exception {
Class::MOP::in_global_destruction();
- } qr/\b deprecated \b/xmsi,
- 'Class::MOP::in_global_destruction is deprecated';
+ }, qr/\b deprecated \b/xmsi, 'Class::MOP::in_global_destruction is deprecated' );
}
{
use Class::MOP::Deprecated -api_version => 0.93;
- ::throws_ok{
+ ::like( ::exception {
Class::MOP::in_global_destruction();
- } qr/\b deprecated \b/xmsi,
- 'Class::MOP::in_global_destruction is deprecated with 0.93 compatibility';
+ }, qr/\b deprecated \b/xmsi, 'Class::MOP::in_global_destruction is deprecated with 0.93 compatibility' );
}
{
use Class::MOP::Deprecated -api_version => 0.92;
- ::lives_ok{
+ ::is( ::exception {
Class::MOP::in_global_destruction();
- }
- 'Class::MOP::in_global_destruction is not deprecated with 0.92 compatibility';
+ }, undef, 'Class::MOP::in_global_destruction is not deprecated with 0.92 compatibility' );
}
{
use metaclass;
- ::throws_ok{ Foo2->meta->get_attribute_map }
- qr/\Qget_attribute_map method has been deprecated/,
- 'get_attribute_map is deprecated';
+ ::like( ::exception { Foo2->meta->get_attribute_map }, qr/\Qget_attribute_map method has been deprecated/, 'get_attribute_map is deprecated' );
}
{
projects / gitmo/Class-MOP.git / commitdiff