convert all uses of Test::Exception to Test::Fatal.
[gitmo/Class-MOP.git] / t / 090_meta_method.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Test::More;
5 use Test::Fatal;
6 use Class::MOP;
7
8 {
9     can_ok('Class::MOP::Class', 'meta');
10     isa_ok(Class::MOP::Class->meta->find_method_by_name('meta'),
11            'Class::MOP::Method::Meta');
12
13     {
14         package Baz;
15         use metaclass;
16     }
17     can_ok('Baz', 'meta');
18     isa_ok(Baz->meta->find_method_by_name('meta'),
19            'Class::MOP::Method::Meta');
20
21     my $meta = Class::MOP::Class->create('Quux');
22     can_ok('Quux', 'meta');
23     isa_ok(Quux->meta->find_method_by_name('meta'),
24            'Class::MOP::Method::Meta');
25 }
26
27 {
28     {
29         package Blarg;
30         use metaclass meta_name => 'blarg';
31     }
32     ok(!Blarg->can('meta'));
33     can_ok('Blarg', 'blarg');
34     isa_ok(Blarg->blarg->find_method_by_name('blarg'),
35            'Class::MOP::Method::Meta');
36
37     my $meta = Class::MOP::Class->create('Blorg', meta_name => 'blorg');
38     ok(!Blorg->can('meta'));
39     can_ok('Blorg', 'blorg');
40     isa_ok(Blorg->blorg->find_method_by_name('blorg'),
41            'Class::MOP::Method::Meta');
42 }
43
44 {
45     {
46         package Foo;
47         use metaclass meta_name => undef;
48     }
49
50     my $meta = Class::MOP::class_of('Foo');
51     ok(!$meta->has_method('meta'), "no meta method was installed");
52     $meta->add_method(meta => sub { die 'META' });
53     ok ! exception { $meta->find_method_by_name('meta') }, "can do meta-level stuff";
54     ok ! exception { $meta->make_immutable }, "can do meta-level stuff";
55     ok ! exception { $meta->class_precedence_list }, "can do meta-level stuff";
56 }
57
58 {
59     my $meta = Class::MOP::Class->create('Bar', meta_name => undef);
60     ok(!$meta->has_method('meta'), "no meta method was installed");
61     $meta->add_method(meta => sub { die 'META' });
62     ok ! exception { $meta->find_method_by_name('meta') }, "can do meta-level stuff";
63     ok ! exception { $meta->make_immutable }, "can do meta-level stuff";
64     ok ! exception { $meta->class_precedence_list }, "can do meta-level stuff";
65 }
66
67 done_testing;