Commit | Line | Data |
38bf2a25 |
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 | is( exception { $meta->find_method_by_name('meta') }, undef, "can do meta-level stuff" ); |
54 | is( exception { $meta->make_immutable }, undef, "can do meta-level stuff" ); |
55 | is( exception { $meta->class_precedence_list }, undef, "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 | is( exception { $meta->find_method_by_name('meta') }, undef, "can do meta-level stuff" ); |
63 | is( exception { $meta->make_immutable }, undef, "can do meta-level stuff" ); |
64 | is( exception { $meta->class_precedence_list }, undef, "can do meta-level stuff" ); |
65 | } |
66 | |
67 | done_testing; |