test_requires 'File::Spec';
test_requires 'Test::More' => '0.88';
-test_requires 'Test::Exception' => '0.27';
+test_requires 'Test::Fatal' => '0.001';
test_requires 'Test::Requires' => '0.05';
author_requires 'Algorithm::C3';
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 {
+ok ! exception {
$Foo->add_method( 'foo' => $foo );
-}
+},
'... 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';
+ok exception { Foo->foo }, '... 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 {
+ok ! exception {
$Bar->add_method( 'foo' => sub {'Bar::foo v2'} );
-}
+},
'... overwriting a method is fine';
is_deeply( [ Class::MOP::get_code_info( $Bar->get_method('foo')->body ) ],
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 {
+ ::ok ! ::exception {
$meta->add_attribute($FOO_ATTR);
- } '... we added an attribute to Foo successfully';
+ }, '... 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 {
+ ::ok ! ::exception {
$meta->add_attribute($BAR_ATTR_2);
- } '... we added an attribute to Foo successfully';
+ }, '... 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 {
+ ::ok ! ::exception {
$meta->add_attribute($BAR_ATTR);
- } '... we added an attribute to Bar successfully';
+ }, '... 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 {
+ ::ok ! ::exception {
$meta->add_attribute($BAZ_ATTR);
- } '... we added an attribute to Baz successfully';
+ }, '... 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 {
+ ok ! exception {
$attr = $meta->remove_attribute('$baz');
- } '... removed the $baz attribute successfully';
+ }, '... 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 {
+ ok ! exception {
$attr = Bar->meta->remove_attribute('$bar');
- } '... removed the $bar attribute successfully';
+ }, '... 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 {
+ ok ! exception {
$val = $meta->remove_attribute('$blammo');
- } '... attempted to remove the non-existent $blammo attribute';
+ }, '... 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 {
+ ::ok ! ::exception {
$meta->add_attribute($FOO_ATTR_2);
- } '... we added an attribute to Buzz successfully';
+ }, '... we added an attribute to Buzz successfully';
- ::lives_ok {
+ ::ok ! ::exception {
$meta->add_attribute(
Class::MOP::Attribute->new(
'$bar' => (
)
)
);
- } '... we added an attribute to Buzz successfully';
+ }, '... we added an attribute to Buzz successfully';
- ::lives_ok {
+ ::ok ! ::exception {
$meta->add_attribute(
Class::MOP::Attribute->new(
'$bah' => (
)
)
);
- } '... we added an attribute to Buzz successfully';
+ }, '... we added an attribute to Buzz successfully';
- ::lives_ok {
+ ::ok ! ::exception {
$meta->add_method(build_foo => sub{ blessed shift; });
- } '... we added a method to Buzz successfully';
+ }, '... we added a method to Buzz successfully';
}
for(1 .. 2){
my $buzz;
- ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
+ ::ok ! ::exception { $buzz = Buzz->meta->new_object }, '...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';
+ ::ok ! ::exception { $buzz2 = Buzz->meta->new_object('$bar' => 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';
+ ::ok ! ::exception { $buzz3 = Buzz->meta->new_object }, '...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';
+ ::ok ! ::exception { $buzz4 = Buzz->meta->new_object('$bah' => 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 {
+ok exception {
$foo_meta->clone_object($meta);
-} '... this dies as expected';
+}, '... 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 {
+ok exception {
$point->x(42);
-} '... cannot write to a read-only accessor';
+}, '... 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 {
+ok ! exception {
Foo->meta->add_package_symbol('%foo' => { one => 1 });
-} '... created %Foo::foo successfully';
+}, '... created %Foo::foo successfully';
# ... scalar should NOT be created here
ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet');
-lives_ok {
+ok ! exception {
Foo->meta->add_package_symbol('@bar' => [ 1, 2, 3 ]);
-} '... created @Foo::bar successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->add_package_symbol('$baz' => 10);
-} '... created $Foo::baz successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->add_package_symbol('&funk' => sub { "Foo::funk" });
-} '... created &Foo::funk successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->add_package_symbol('@foo' => $ARRAY);
-} '... created @Foo::foo successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->add_package_symbol('&foo' => $CODE);
-} '... created &Foo::foo successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->add_package_symbol('$foo' => 'Foo::foo');
-} '... created $Foo::foo successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->remove_package_symbol('%foo');
-} '... removed %Foo::foo successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->remove_package_symbol('&foo');
-} '... removed &Foo::foo successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->remove_package_symbol('$foo');
-} '... removed $Foo::foo successfully';
+}, '... 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 {
+ok exception {
$point->x(42);
-} '... cannot write to a read-only accessor';
+}, '... 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 {
+ ok exception {
Class::MOP::Class->initialize();
- } '... initialize requires a name parameter';
+ }, '... initialize requires a name parameter';
- dies_ok {
+ ok exception {
Class::MOP::Class->initialize('');
- } '... initialize requires a name valid parameter';
+ }, '... initialize requires a name valid parameter';
- dies_ok {
+ ok exception {
Class::MOP::Class->initialize(bless {} => 'Foo');
- } '... initialize requires an unblessed parameter'
+ }, '... initialize requires an unblessed parameter'
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->_construct_class_instance();
- } '... _construct_class_instance requires an :package parameter';
+ }, '... _construct_class_instance requires an :package parameter';
- dies_ok {
+ ok exception {
Class::MOP::Class->_construct_class_instance(':package' => undef);
- } '... _construct_class_instance requires a defined :package parameter';
+ }, '... _construct_class_instance requires a defined :package parameter';
- dies_ok {
+ ok exception {
Class::MOP::Class->_construct_class_instance(':package' => '');
- } '... _construct_class_instance requires a valid :package parameter';
+ }, '... _construct_class_instance requires a valid :package parameter';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->create();
- } '... create requires an package_name parameter';
+ }, '... create requires an package_name parameter';
- dies_ok {
+ ok exception {
Class::MOP::Class->create(undef);
- } '... create requires a defined package_name parameter';
+ }, '... create requires a defined package_name parameter';
- dies_ok {
+ ok exception {
Class::MOP::Class->create('');
- } '... create requires a valid package_name parameter';
+ }, '... 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 {
+ ok exception {
Class::MOP::Class->clone_object(1);
- } '... can only clone instances';
+ }, '... can only clone instances';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->add_method();
- } '... add_method dies as expected';
+ }, '... add_method dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->add_method('');
- } '... add_method dies as expected';
+ }, '... add_method dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->add_method('foo' => 'foo');
- } '... add_method dies as expected';
+ }, '... add_method dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->add_method('foo' => []);
- } '... add_method dies as expected';
+ }, '... add_method dies as expected';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->has_method();
- } '... has_method dies as expected';
+ }, '... has_method dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->has_method('');
- } '... has_method dies as expected';
+ }, '... has_method dies as expected';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->get_method();
- } '... get_method dies as expected';
+ }, '... get_method dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->get_method('');
- } '... get_method dies as expected';
+ }, '... get_method dies as expected';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->remove_method();
- } '... remove_method dies as expected';
+ }, '... remove_method dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->remove_method('');
- } '... remove_method dies as expected';
+ }, '... remove_method dies as expected';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->find_all_methods_by_name();
- } '... find_all_methods_by_name dies as expected';
+ }, '... find_all_methods_by_name dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->find_all_methods_by_name('');
- } '... find_all_methods_by_name dies as expected';
+ }, '... find_all_methods_by_name dies as expected';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->add_attribute(bless {} => 'Foo');
- } '... add_attribute dies as expected';
+ }, '... add_attribute dies as expected';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->has_attribute();
- } '... has_attribute dies as expected';
+ }, '... has_attribute dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->has_attribute('');
- } '... has_attribute dies as expected';
+ }, '... has_attribute dies as expected';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->get_attribute();
- } '... get_attribute dies as expected';
+ }, '... get_attribute dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->get_attribute('');
- } '... get_attribute dies as expected';
+ }, '... get_attribute dies as expected';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->remove_attribute();
- } '... remove_attribute dies as expected';
+ }, '... remove_attribute dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->remove_attribute('');
- } '... remove_attribute dies as expected';
+ }, '... remove_attribute dies as expected';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->add_package_symbol();
- } '... add_package_symbol dies as expected';
+ }, '... add_package_symbol dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->add_package_symbol('');
- } '... add_package_symbol dies as expected';
+ }, '... add_package_symbol dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->add_package_symbol('foo');
- } '... add_package_symbol dies as expected';
+ }, '... add_package_symbol dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->add_package_symbol('&foo');
- } '... add_package_symbol dies as expected';
+ }, '... add_package_symbol dies as expected';
-# throws_ok {
+# like exception {
# Class::MOP::Class->meta->add_package_symbol('@-');
# } qr/^Could not create package variable \(\@\-\) because/,
# '... add_package_symbol dies as expected';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->has_package_symbol();
- } '... has_package_symbol dies as expected';
+ }, '... has_package_symbol dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->has_package_symbol('');
- } '... has_package_symbol dies as expected';
+ }, '... has_package_symbol dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->has_package_symbol('foo');
- } '... has_package_symbol dies as expected';
+ }, '... has_package_symbol dies as expected';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->get_package_symbol();
- } '... get_package_symbol dies as expected';
+ }, '... get_package_symbol dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->get_package_symbol('');
- } '... get_package_symbol dies as expected';
+ }, '... get_package_symbol dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->get_package_symbol('foo');
- } '... get_package_symbol dies as expected';
+ }, '... get_package_symbol dies as expected';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Class->remove_package_symbol();
- } '... remove_package_symbol dies as expected';
+ }, '... remove_package_symbol dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->remove_package_symbol('');
- } '... remove_package_symbol dies as expected';
+ }, '... remove_package_symbol dies as expected';
- dies_ok {
+ ok exception {
Class::MOP::Class->remove_package_symbol('foo');
- } '... remove_package_symbol dies as expected';
+ }, '... remove_package_symbol dies as expected';
}
done_testing;
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
}
);
- ::throws_ok(
+ ::like (::exception(
sub {
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 {
+ok ! exception {
$savings_account->withdraw(50);
-}
+},
'... withdrew from savings successfully';
is( $savings_account->balance, 200,
'... got the right savings balance after withdrawal' );
-dies_ok {
+ok exception {
$savings_account->withdraw(250);
-}
+},
'... could not withdraw from savings successfully';
$savings_account->deposit(150);
is( $checking_account->balance, 100, '... got the right checkings balance' );
-lives_ok {
+ok ! exception {
$checking_account->withdraw(50);
-}
+},
'... withdrew from checking successfully';
is( $checking_account->balance, 50,
'... got the right checkings balance after withdrawal' );
'... got the right savings balance after checking withdrawal (no overdraft)'
);
-lives_ok {
+ok ! exception {
$checking_account->withdraw(200);
-}
+},
'... withdrew from checking successfully';
is( $checking_account->balance, 0,
'... got the right checkings balance after withdrawal' );
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use Class::MOP;
[$anon_class->superclasses],
[],
'... got an empty superclass list');
- lives_ok {
+ ok ! exception {
$anon_class->superclasses('Foo');
- } '... can add a superclass to anon class';
+ }, '... 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 {
+ ok ! exception {
$anon_class->add_method('foo' => sub { "__ANON__::foo" });
- } '... added a method to my anon-class';
+ }, '... 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};
+ok exception { Class::MOP::Attribute->name }, q{... can't call name() as a class method};
{
my $class = Class::MOP::Class->initialize('Foo');
isa_ok($class, 'Class::MOP::Class');
- lives_ok {
+ ok ! exception {
$attr->attach_to_class($class);
- } '... attached a class successfully';
+ }, '... 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 {
+ ok ! 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';
+ }, '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 {
+ ok exception {
Class::MOP::Attribute->new('$test' => (
default => qr/hello (.*)/
));
- } '... no refs for defaults';
+ }, '... no refs for defaults';
- dies_ok {
+ ok exception {
Class::MOP::Attribute->new('$test' => (
default => []
));
- } '... no refs for defaults';
+ }, '... no refs for defaults';
- dies_ok {
+ ok exception {
Class::MOP::Attribute->new('$test' => (
default => {}
));
- } '... no refs for defaults';
+ }, '... no refs for defaults';
- dies_ok {
+ ok exception {
Class::MOP::Attribute->new('$test' => (
default => \(my $var)
));
- } '... no refs for defaults';
+ }, '... no refs for defaults';
- dies_ok {
+ ok exception {
Class::MOP::Attribute->new('$test' => (
default => bless {} => 'Foo'
));
- } '... no refs for defaults';
+ }, '... no refs for defaults';
}
{
- dies_ok {
+ ok exception {
Class::MOP::Attribute->new('$test' => (
builder => qr/hello (.*)/
));
- } '... no refs for builders';
+ }, '... no refs for builders';
- dies_ok {
+ ok exception {
Class::MOP::Attribute->new('$test' => (
builder => []
));
- } '... no refs for builders';
+ }, '... no refs for builders';
- dies_ok {
+ ok exception {
Class::MOP::Attribute->new('$test' => (
builder => {}
));
- } '... no refs for builders';
+ }, '... no refs for builders';
- dies_ok {
+ ok exception {
Class::MOP::Attribute->new('$test' => (
builder => \(my $var)
));
- } '... no refs for builders';
+ }, '... no refs for builders';
- dies_ok {
+ ok exception {
Class::MOP::Attribute->new('$test' => (
builder => bless {} => 'Foo'
));
- } '... no refs for builders';
+ }, '... no refs for builders';
- dies_ok {
+ ok exception {
Class::MOP::Attribute->new('$test' => (
builder => 'Foo', default => 'Foo'
));
- } '... no default AND builder';
+ }, '... no default AND builder';
my $undef_attr;
- lives_ok {
+ ok ! exception {
$undef_attr = Class::MOP::Attribute->new('$test' => (
default => undef,
predicate => 'has_test',
));
- } '... undef as a default is okay';
+ }, '... 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 }
+ ok ! exception { Foo->meta->make_immutable },
'... and it can be inlined';
{
my $obj = Foo->new;
{ # bad construtor args
- dies_ok {
+ ok exception {
Class::MOP::Attribute->new();
- } '... no name argument';
+ }, '... no name argument';
# These are no longer errors
- lives_ok {
+ ok ! exception {
Class::MOP::Attribute->new('');
- } '... bad name argument';
+ }, '... bad name argument';
- lives_ok {
+ ok ! exception {
Class::MOP::Attribute->new(0);
- } '... bad name argument';
+ }, '... bad name argument';
}
{
my $attr = Class::MOP::Attribute->new('$test');
- dies_ok {
+ ok exception {
$attr->attach_to_class();
- } '... attach_to_class died as expected';
+ }, '... attach_to_class died as expected';
- dies_ok {
+ ok exception {
$attr->attach_to_class('Fail');
- } '... attach_to_class died as expected';
+ }, '... attach_to_class died as expected';
- dies_ok {
+ ok exception {
$attr->attach_to_class(bless {} => 'Fail');
- } '... attach_to_class died as expected';
+ }, '... attach_to_class died as expected';
}
{
$attr->attach_to_class(Class::MOP::Class->initialize('Foo'));
- dies_ok {
+ ok exception {
$attr->install_accessors;
- } '... bad reader format';
+ }, '... bad reader format';
}
{
my $attr = Class::MOP::Attribute->new('$test');
- dies_ok {
+ ok exception {
$attr->_process_accessors('fail', 'my_failing_sub');
- } '... cannot find "fail" type generator';
+ }, '... cannot find "fail" type generator';
}
reader => 'test'
));
- dies_ok {
+ ok exception {
$attr->install_accessors;
- } '... failed to generate accessors correctly';
+ }, '... failed to generate accessors correctly';
}
{
# it works, which is kinda silly, but it
# tests the API change, so I keep it.
- lives_ok {
+ ok ! exception {
Class::MOP::Attribute->new('$foo', (
accessor => 'foo',
reader => 'get_foo',
));
- } '... can create accessors with reader/writers';
+ }, '... can create accessors with reader/writers';
- lives_ok {
+ ok ! exception {
Class::MOP::Attribute->new('$foo', (
accessor => 'foo',
writer => 'set_foo',
));
- } '... can create accessors with reader/writers';
+ }, '... can create accessors with reader/writers';
- lives_ok {
+ ok ! exception {
Class::MOP::Attribute->new('$foo', (
accessor => 'foo',
reader => 'get_foo',
writer => 'set_foo',
));
- } '... can create accessors with reader/writers';
+ }, '... 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 }
+ok exception { Class::MOP::Method->wrap },
q{... can't call wrap() without some code};
-dies_ok { Class::MOP::Method->wrap( [] ) }
+ok exception { Class::MOP::Method->wrap( [] ) },
q{... can't call wrap() without some code};
-dies_ok { Class::MOP::Method->wrap( bless {} => 'Fail' ) }
+ok exception { Class::MOP::Method->wrap( bless {} => 'Fail' ) },
q{... can't call wrap() without some code};
-dies_ok { Class::MOP::Method->name }
+ok exception { Class::MOP::Method->name },
q{... can't call name() as a class method};
-dies_ok { Class::MOP::Method->body }
+ok exception { Class::MOP::Method->body },
q{... can't call body() as a class method};
-dies_ok { Class::MOP::Method->package_name }
+ok exception { Class::MOP::Method->package_name },
q{... can't call package_name() as a class method};
-dies_ok { Class::MOP::Method->fully_qualified_name }
+ok exception { Class::MOP::Method->fully_qualified_name },
q{... can't call fully_qualified_name() as a class method};
my $meta = Class::MOP::Method->meta;
'... our sub name is "' . $method_name . '"' );
}
-dies_ok {
+ok exception {
Class::MOP::Method->wrap();
-}
+},
'... bad args for &wrap';
-dies_ok {
+ok exception {
Class::MOP::Method->wrap('Fail');
-}
+},
'... bad args for &wrap';
-dies_ok {
+ok exception {
Class::MOP::Method->wrap( [] );
-}
+},
'... bad args for &wrap';
-dies_ok {
+ok exception {
Class::MOP::Method->wrap( sub {'FAIL'} );
-}
+},
'... bad args for &wrap';
-dies_ok {
+ok exception {
Class::MOP::Method->wrap( sub {'FAIL'}, package_name => 'main' );
-}
+},
'... bad args for &wrap';
-dies_ok {
+ok exception {
Class::MOP::Method->wrap( sub {'FAIL'}, name => '__ANON__' );
-}
+},
'... bad args for &wrap';
-lives_ok {
+ok ! exception {
Class::MOP::Method->wrap( bless( sub {'FAIL'}, "Foo" ),
name => '__ANON__', package_name => 'Foo::Bar' );
-}
+},
'... blessed coderef to &wrap';
my $clone = $method->clone(
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 {
+ ok ! exception {
$wrapped->add_before_modifier( sub { $trace .= 'before -> ' } );
- }
+ },
'... added the before modifier okay';
$wrapped->();
);
$trace = '';
- lives_ok {
+ ok ! exception {
$wrapped->add_after_modifier( sub { $trace .= ' -> after' } );
- }
+ },
'... added the after modifier okay';
$wrapped->();
is( $wrapped->(), 4, '... got the right value from the wrapped method' );
- lives_ok {
+ ok ! 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';
is_deeply(
isa_ok( $wrapped, 'Class::MOP::Method::Wrapped' );
isa_ok( $wrapped, 'Class::MOP::Method' );
- lives_ok {
+ ok ! 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';
- lives_ok {
+ ok ! 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';
- lives_ok {
+ ok ! 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';
$wrapped->();
use warnings;
use Test::More;
-use Test::Exception;
+use Test::Fatal;
use metaclass;
# checking...
-lives_ok {
+ok ! exception {
Foo::Meta::Class->create('Foo')
-} '... Foo.meta => Foo::Meta::Class is compatible';
-lives_ok {
+}, '... Foo.meta => Foo::Meta::Class is compatible';
+ok ! exception {
Bar::Meta::Class->create('Bar')
-} '... Bar.meta => Bar::Meta::Class is compatible';
+}, '... 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 {
+ok ! exception {
FooBar::Meta::Class->create('FooBar', superclasses => ['Foo'])
-} '... FooBar.meta => FooBar::Meta::Class is compatible';
-lives_ok {
+}, '... FooBar.meta => FooBar::Meta::Class is compatible';
+ok ! exception {
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,
);
-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 {
+ok ! exception {
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');
-lives_ok {
+ok ! exception {
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');
-lives_ok {
+ok ! 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';
+}, '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 {
+ ok ! 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";
+ }, "$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') }
+ like exception { $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);
- lives_ok { $bazmeta->superclasses($barmeta->name) }
+ ok ! exception { $bazmeta->superclasses($barmeta->name) },
"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";
+ ok ! exception { $bazmeta->make_immutable }, "can still make immutable";
}
# nonexistent metaclasses
superclasses => ['Class::MOP::Method'],
);
-lives_ok {
+ok ! exception {
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");
-lives_ok {
+ok ! 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 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 {
+ok ! exception {
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";
-lives_ok {
+ok ! exception {
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");
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";
+ok exception { $foo->child }, "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) }
+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) }
+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";
+ok exception { $foo->child }, "Parent->child method doesn't exist";
-throws_ok { LeftField->meta->rebless_instance_back($foo) }
+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) }
+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
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 {
+ ok ! exception {
Bar->meta->rebless_instance($foo)
- } '... this works';
+ }, '... 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 {
+ ok ! exception {
Foo->meta->rebless_instance_back($foo)
- } '... this works';
+ }, '... 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 {
+ ok ! exception {
Bar->meta->rebless_instance($foo, (baz => 'FOO-BAZ'))
- } '... this works';
+ }, '... 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 {
+ ok ! exception {
Foo->meta->rebless_instance_back($foo)
- } '... this works';
+ }, '... 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 {
+ ok ! exception {
Bar->meta->rebless_instance($foo, (bar => 'FOO-BAR', baz => 'FOO-BAZ'))
- } '... this works';
+ }, '... 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 {
+ ok ! exception {
Foo->meta->rebless_instance_back($foo)
- } '... this works';
+ }, '... 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 {
+ ok ! exception {
$bar_meta = $meta_name->initialize('Bar');
- } "we can use the name on its own";
+ }, "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 {
+ok ! exception {
$meta = $meta->reinitialize($meta->name);
};
check_meta_sanity($meta, 'Foo');
-lives_ok {
+ok ! exception {
$meta = $meta->reinitialize($meta);
};
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 {
+ok ! exception {
$meta = $meta->reinitialize('Bar');
};
check_meta_sanity($meta, 'Bar');
is(Bar->meta->get_method('foo')->test, 'FOO');
is(Bar->meta->get_attribute('bar')->tset, 'OOF');
-lives_ok {
+ok ! exception {
$meta = $meta->reinitialize('Bar');
};
is(Bar->meta->get_method('foo')->test, 'FOO');
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 {
+ok ! exception {
$meta = $meta->reinitialize(
'Baz',
attribute_metaclass => '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 {
+ok ! exception {
$meta = $meta->reinitialize(
'Quuux',
attribute_metaclass => 'Quuux::Meta::Attribute',
$meta = Class::MOP::class_of('Blah');
check_meta_sanity($meta, 'Blah');
-lives_ok {
+ok ! exception {
$meta = Class::MOP::Class->reinitialize(
'Blah',
attribute_metaclass => 'Blah::Meta::Attribute',
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 {
+ok ! exception {
my $foo = Foo::Sub->new;
isa_ok($foo, 'Foo');
isa_ok($foo, 'Foo::Sub');
};
undef $instance;
-lives_and {
+ok ! exception {
my $foo = Foo::Sub->new(foo => 'FOO');
isa_ok($foo, 'Foo');
isa_ok($foo, 'Foo::Sub');
};
undef $instance;
-lives_and {
+ok ! exception {
my $foo = Foo::Sub->new(bar => 'bar');
isa_ok($foo, 'Foo');
isa_ok($foo, 'Foo::Sub');
};
undef $instance;
-lives_and {
+ok ! exception {
my $foo = Foo::Sub->new(foo => 'FOO', bar => 'bar');
isa_ok($foo, 'Foo');
isa_ok($foo, 'Foo::Sub');
);
}
-throws_ok { BadFoo::Sub->new }
+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';
+ ok exception { $meta->add_method() }, '... exception thrown as expected';
+ ok exception { $meta->alias_method() }, '... exception thrown as expected';
+ ok exception { $meta->remove_method() }, '... exception thrown as expected';
- dies_ok { $meta->add_attribute() } '... exception thrown as expected';
- dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
+ ok exception { $meta->add_attribute() }, '... exception thrown as expected';
+ ok exception { $meta->remove_attribute() }, '... exception thrown as expected';
- dies_ok { $meta->add_package_symbol() }
+ ok exception { $meta->add_package_symbol() },
'... exception thrown as expected';
- dies_ok { $meta->remove_package_symbol() }
+ ok exception { $meta->remove_package_symbol() },
'... exception thrown as expected';
- lives_ok { $meta->identifier() }
+ ok ! exception { $meta->identifier() },
'... no exception for get_package_symbol special case';
my @supers;
- lives_ok {
+ ok ! exception {
@supers = $meta->superclasses;
- }
+ },
'... got the superclasses okay';
- dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
+ ok exception { $meta->superclasses( ['UNIVERSAL'] ) },
'... but could not set the superclasses okay';
my $meta_instance;
- lives_ok {
+ ok ! exception {
$meta_instance = $meta->get_meta_instance;
- }
+ },
'... 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 {
+ ok ! exception {
@cpl = $meta->class_precedence_list;
- }
+ },
'... got the class precedence list okay';
is_deeply(
\@cpl,
);
my @attributes;
- lives_ok {
+ ok ! exception {
@attributes = $meta->get_all_attributes;
- }
+ },
'... got the attribute list okay';
is_deeply(
\@attributes,
ok( $meta->is_mutable, '... our class is mutable' );
ok( !$meta->is_immutable, '... our class is not immutable' );
- lives_ok {
+ ok ! exception {
$meta->make_immutable();
- }
+ },
'... 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';
+ ok exception { $meta->add_method() }, '... exception thrown as expected';
+ ok exception { $meta->alias_method() }, '... exception thrown as expected';
+ ok exception { $meta->remove_method() }, '... exception thrown as expected';
- dies_ok { $meta->add_attribute() } '... exception thrown as expected';
- dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
+ ok exception { $meta->add_attribute() }, '... exception thrown as expected';
+ ok exception { $meta->remove_attribute() }, '... exception thrown as expected';
- dies_ok { $meta->add_package_symbol() }
+ ok exception { $meta->add_package_symbol() },
'... exception thrown as expected';
- dies_ok { $meta->remove_package_symbol() }
+ ok exception { $meta->remove_package_symbol() },
'... exception thrown as expected';
my @supers;
- lives_ok {
+ ok ! exception {
@supers = $meta->superclasses;
- }
+ },
'... got the superclasses okay';
- dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
+ ok exception { $meta->superclasses( ['UNIVERSAL'] ) },
'... but could not set the superclasses okay';
my $meta_instance;
- lives_ok {
+ ok ! exception {
$meta_instance = $meta->get_meta_instance;
- }
+ },
'... 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 {
+ ok ! exception {
@cpl = $meta->class_precedence_list;
- }
+ },
'... got the class precedence list okay';
is_deeply(
\@cpl,
);
my @attributes;
- lives_ok {
+ ok ! exception {
@attributes = $meta->get_all_attributes;
- }
+ },
'... got the attribute list okay';
is_deeply(
[ sort { $a->name cmp $b->name } @attributes ],
ok( $meta->is_mutable, '... our class is mutable' );
ok( !$meta->is_immutable, '... our class is not immutable' );
- lives_ok {
+ ok ! exception {
$meta->make_immutable();
- }
+ },
'... 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';
+ ok exception { $meta->add_method() }, '... exception thrown as expected';
+ ok exception { $meta->alias_method() }, '... exception thrown as expected';
+ ok exception { $meta->remove_method() }, '... exception thrown as expected';
- dies_ok { $meta->add_attribute() } '... exception thrown as expected';
- dies_ok { $meta->remove_attribute() } '... exception thrown as expected';
+ ok exception { $meta->add_attribute() }, '... exception thrown as expected';
+ ok exception { $meta->remove_attribute() }, '... exception thrown as expected';
- dies_ok { $meta->add_package_symbol() }
+ ok exception { $meta->add_package_symbol() },
'... exception thrown as expected';
- dies_ok { $meta->remove_package_symbol() }
+ ok exception { $meta->remove_package_symbol() },
'... exception thrown as expected';
my @supers;
- lives_ok {
+ ok ! exception {
@supers = $meta->superclasses;
- }
+ },
'... got the superclasses okay';
- dies_ok { $meta->superclasses( ['UNIVERSAL'] ) }
+ ok exception { $meta->superclasses( ['UNIVERSAL'] ) },
'... but could not set the superclasses okay';
my $meta_instance;
- lives_ok {
+ ok ! exception {
$meta_instance = $meta->get_meta_instance;
- }
+ },
'... 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 {
+ ok ! exception {
@cpl = $meta->class_precedence_list;
- }
+ },
'... got the class precedence list okay';
is_deeply(
\@cpl,
);
my @attributes;
- lives_ok {
+ ok ! exception {
@attributes = $meta->get_all_attributes;
- }
+ },
'... 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') }
+ ::ok ! ::exception { Baz->meta->superclasses('Bar') },
'... 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";
+ ok ! exception { $meta->make_immutable }, "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";
+ ok ! exception { $meta->make_mutable }, "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 {
+ ok ! exception {
$meta->make_immutable(
inline_constructor => 1,
inline_accessors => 0,
);
- } '... changed Foo to be immutable';
+ }, '... 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 {
+ ok ! exception {
$meta->make_immutable(
inline_constructor => 1,
inline_accessors => 1,
);
- } '... changed Bar to be immutable';
+ }, '... 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 {
+ ok ! exception {
$meta->make_immutable(
inline_constructor => 0,
inline_accessors => 1,
);
- } '... changed Bar to be immutable';
+ }, '... 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';
+ ::ok ! ::exception { $buzz = Buzz->meta->new_object }, '...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';
+ ::ok ! ::exception { $buzz2 = Buzz->meta->new_object('bar' => 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';
+ ::ok ! ::exception { $buzz = Buzz->meta->new_object }, '...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';
+ ::ok ! ::exception { $buzz2 = Buzz->meta->new_object('bah' => 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';
+ ok ! exception { $meta->make_immutable; }, '... 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';
+ ok ! exception { $meta->make_mutable; }, '... 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';
+ ok ! exception { $meta->remove_package_symbol('$ref') }, '... 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';
+ ok ! exception { $meta->make_immutable; }, '... 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';
+ ok ! exception { $meta->make_immutable() }, 'Changed Baz to be immutable';
+ ok ! exception { $meta->make_mutable() }, '... changed Baz to be mutable';
+ ok ! exception { $meta->make_immutable() }, '... changed Baz to be immutable';
- dies_ok{ $meta->add_method('xyz', sub{'xxx'}) } '... exception thrown as expected';
+ ok exception { $meta->add_method('xyz', sub{'xxx'}) }, '... exception thrown as expected';
- dies_ok {
+ ok exception {
$meta->add_attribute('fickle', accessor => 'fickle')
- } '... exception thrown as expected';
- dies_ok { $meta->remove_attribute('fickle') } '... exception thrown as expected';
+ }, '... exception thrown as expected';
+ ok exception { $meta->remove_attribute('fickle') }, '... 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';
+ ok exception { $meta->add_package_symbol('$ref', $reef) }, '... exception thrown as expected';
+ ok exception { $meta->remove_package_symbol('$ref') }, '... exception thrown as expected';
ok( my @supers = $meta->superclasses, '... got the superclasses okay');
- dies_ok { $meta->superclasses('Foo') } '... set the superclasses';
+ ok exception { $meta->superclasses('Foo') }, '... 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(
+ ok ! exception {$meta->make_immutable(
inline_accessor => 1,
inline_destructor => 0,
inline_constructor => 1,
)
- } '... changed class to be immutable';
+ }, '... 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';
+ ok ! exception { $meta->make_mutable }, '... 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';
+ ok ! exception { $meta->remove_package_symbol('$ref') }, '... 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(
- 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';
+ ok ! exception {
+ $meta->make_immutable(
+ inline_accessor => 1,
+ inline_destructor => 0,
+ inline_constructor => 1,
+ )
+ }, '... changed class to be immutable';
+ ok ! exception { $meta->make_mutable() }, '... changed class to be mutable';
+ ok ! exception { $meta->make_immutable }, '... changed class to be immutable';
- dies_ok{ $meta->add_method('xyz', sub{'xxx'}) } '... exception thrown as expected';
+ ok exception { $meta->add_method('xyz', sub{'xxx'}) }, '... exception thrown as expected';
- dies_ok {
+ ok exception {
$meta->add_attribute('fickle', accessor => 'fickle')
- } '... exception thrown as expected';
- dies_ok { $meta->remove_attribute('fickle') } '... exception thrown as expected';
+ }, '... exception thrown as expected';
+ ok exception { $meta->remove_attribute('fickle') }, '... 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';
+ ok exception { $meta->add_package_symbol('$ref', $reef) }, '... exception thrown as expected';
+ ok exception { $meta->remove_package_symbol('$ref') }, '... exception thrown as expected';
ok( my @supers = $meta->superclasses, '... got the superclasses okay');
- dies_ok { $meta->superclasses('Foo') } '... set the superclasses';
+ ok exception { $meta->superclasses('Foo') }, '... 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 }
+ ::ok ! ::exception { __PACKAGE__->meta->make_immutable },
'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};
+ok exception { Class::MOP::Package->get_all_package_symbols }, q{... can't call get_all_package_symbols() as a class method};
+ok exception { Class::MOP::Package->name }, 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 {
+ok ! exception {
Foo->meta->add_package_symbol('%foo' => { one => 1 });
-} '... created %Foo::foo successfully';
+}, '... created %Foo::foo successfully';
# ... scalar should NOT be created here
ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet');
-lives_ok {
+ok ! exception {
Foo->meta->add_package_symbol('@bar' => [ 1, 2, 3 ]);
-} '... created @Foo::bar successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->add_package_symbol('$baz' => 10);
-} '... created $Foo::baz successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->add_package_symbol('&funk' => sub { "Foo::funk" });
-} '... created &Foo::funk successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->add_package_symbol('@foo' => $ARRAY);
-} '... created @Foo::foo successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->add_package_symbol('&foo' => $CODE);
-} '... created &Foo::foo successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->add_package_symbol('$foo' => 'Foo::foo');
-} '... created $Foo::foo successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->remove_package_symbol('%foo');
-} '... removed %Foo::foo successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->remove_package_symbol('&foo');
-} '... removed &Foo::foo successfully';
+}, '... 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 {
+ok ! exception {
Foo->meta->remove_package_symbol('$foo');
-} '... removed $Foo::foo successfully';
+}, '... 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 {
+ok ! exception {
$meta->add_package_symbol('%foo' => { one => 1 });
-} '... the %foo symbol is created succcessfully';
+}, '... 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 {
+ok ! exception {
$meta->add_package_symbol('@bar' => [ 1, 2, 3 ]);
-} '... created @Foo::bar successfully';
+}, '... 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 {
+ok ! exception {
$meta->add_package_symbol('%baz');
-} '... created %Foo::baz successfully';
+}, '... 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 {
+ok exception {
Class::MOP::is_class_loaded()
-} "is_class_loaded with no argument dies";
+}, "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 /;
-throws_ok {
+like exception {
Class::MOP::load_class('SyntaxError');
-}
+},
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';
-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';
use constant foo => "bar";
}
-lives_ok {
+ok ! exception {
ok(Class::MOP::is_class_loaded("Other"), 'is_class_loaded(Other)');
-}
+},
"a class with just constants is still a class";
{
use metaclass;
}
-lives_ok {
+ok ! 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';
+}, '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/,
+ }, qr/Class::WithVersion version 42 required--this is only version 23/,
'load_first_existing_class gives correct exception on old version';
- lives_ok {
+ ok ! exception {
Class::MOP::load_first_existing_class('Affe', 'Tiger', 'Class::WithVersion' => { -version => 13 });
- } 'loading class with required version with load_first_existing_class';
+ }, '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/,
+ }, qr/Class::WithVersion version 42 required--this is only version 23/,
'load_class gives correct exception on old version';
- lives_ok {
+ ok ! exception {
Class::MOP::load_class('Class::WithVersion' => { -version => 13 });
- } 'loading class with required version with load_class';
+ }, '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 {
+ok ! exception {
Class::MOP::load_class('TestClassLoaded::Sub');
};
TestClassLoaded->can('a_method');
-lives_ok {
+ok ! exception {
Class::MOP::load_class('TestClassLoaded');
};
-lives_ok {
+ok ! exception {
TestClassLoaded->a_method;
};
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";
+ ok ! exception { $meta->find_method_by_name('meta') }, "can do meta-level stuff";
+ ok ! exception { $meta->make_immutable }, "can do meta-level stuff";
+ ok ! exception { $meta->class_precedence_list }, "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";
+ ok ! exception { $meta->find_method_by_name('meta') }, "can do meta-level stuff";
+ ok ! exception { $meta->make_immutable }, "can do meta-level stuff";
+ ok ! exception { $meta->class_precedence_list }, "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 {
+ok ! exception {
Class::MOP::load_class('BinaryTree');
-} '... loaded the BinaryTree class without dying';
+}, '... 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 {
+ok ! exception {
Foo->meta->superclasses('Bar');
-} "regular subclass";
+}, "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 };
+ ok ! exception { $meta_method->execute },;
}
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 {
+ ok ! 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';
is_deeply(
\%results, { base => 2, wrapped => 2 },
%results = ();
my $o = $meta->get_meta_instance->create_instance;
isa_ok( $o, 'Base' );
- lives_ok {
+ ok ! 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';
is_deeply(
\%results, { base => 2, wrapped => 4 },
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)';
+ ok ! exception { Class::MOP::load_class($value) }, 'load_class(tied scalar)';
$value = undef;
$x->STORE('Class::MOP'); # reset
- lives_and{
+ ok ! exception {
ok Class::MOP::is_class_loaded($value);
- } 'is_class_loaded(tied scalar)';
+ }, 'is_class_loaded(tied scalar)';
$value = undef;
$x->STORE(\&Class::MOP::get_code_info); # reset
- lives_and{
+ ok ! exception {
is_deeply [Class::MOP::get_code_info($value)], [qw(Class::MOP get_code_info)], 'get_code_info(tied scalar)';
- }
+ };
}
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,
+ }, 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,
+ }, 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{
+ ::ok ! ::exception {
Class::MOP::in_global_destruction();
- }
+ },
'Class::MOP::in_global_destruction is not deprecated with 0.92 compatibility';
}
use metaclass;
- ::throws_ok{ Foo2->meta->get_attribute_map }
+ ::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