Commit | Line | Data |
c3398f5b |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
612d3e1a |
4 | use Test::More tests => 26; |
8e64d0fa |
5 | use Test::Exception; |
6 | { |
c3398f5b |
7 | package Class; |
8 | use Mouse; |
8e64d0fa |
9 | use Scalar::Util qw(blessed weaken); # import external functions |
c3398f5b |
10 | |
11 | has pawn => ( |
12 | is => 'rw', |
13 | predicate => 'has_pawn', |
14 | ); |
15 | |
8e64d0fa |
16 | use constant MY_CONST => 42; |
17 | |
18 | sub stub; |
19 | sub stub_with_attr :method; |
20 | |
c3398f5b |
21 | no Mouse; |
8e64d0fa |
22 | } |
23 | { |
24 | package Child; |
25 | use Mouse; |
26 | use Carp qw(carp croak); # import extenral functions |
27 | |
28 | extends 'Class'; |
29 | |
30 | has bishop => ( |
31 | is => 'rw', |
32 | ); |
33 | |
34 | sub child_method{ } |
35 | } |
c3398f5b |
36 | |
37 | my $meta = Class->meta; |
306290e8 |
38 | isa_ok($meta, 'Mouse::Meta::Class'); |
c3398f5b |
39 | |
40 | is_deeply([$meta->superclasses], ['Mouse::Object'], "correctly inherting from Mouse::Object"); |
41 | |
42 | my $meta2 = Class->meta; |
43 | is($meta, $meta2, "same metaclass instance"); |
44 | |
8e64d0fa |
45 | can_ok($meta, qw( |
46 | name meta |
47 | has_attribute get_attribute get_attribute_list get_all_attributes |
48 | has_method get_method get_method_list get_all_methods |
49 | )); |
c3398f5b |
50 | |
986ff64a |
51 | ok($meta->has_attribute('pawn')); |
c3398f5b |
52 | my $attr = $meta->get_attribute('pawn'); |
306290e8 |
53 | isa_ok($attr, 'Mouse::Meta::Attribute'); |
c3398f5b |
54 | is($attr->name, 'pawn', 'got the correct attribute'); |
55 | |
c68b4110 |
56 | my $list = [$meta->get_attribute_list]; |
57 | is_deeply($list, [ 'pawn' ], "attribute list"); |
58 | |
986ff64a |
59 | ok(!$meta->has_attribute('nonexistent_attribute')); |
60 | |
8e64d0fa |
61 | ok($meta->has_method('pawn')); |
62 | lives_and{ |
63 | ok($meta->get_method('pawn')); |
64 | is($meta->get_method('pawn')->name, 'pawn'); |
65 | is($meta->get_method('pawn')->package_name, 'Class'); |
66 | }; |
67 | |
68 | is( join(' ', sort $meta->get_method_list), |
69 | join(' ', sort qw(meta pawn has_pawn MY_CONST stub stub_with_attr)) |
70 | ); |
71 | |
72 | eval q{ |
c3398f5b |
73 | package Class; |
74 | use Mouse; |
75 | no Mouse; |
8e64d0fa |
76 | }; |
c3398f5b |
77 | |
78 | my $meta3 = Class->meta; |
79 | is($meta, $meta3, "same metaclass instance, even if use Mouse is performed again"); |
80 | |
81 | is($meta->name, 'Class', "name for the metaclass"); |
82 | |
c3398f5b |
83 | |
84 | my $child_meta = Child->meta; |
306290e8 |
85 | isa_ok($child_meta, 'Mouse::Meta::Class'); |
c3398f5b |
86 | |
87 | isnt($meta, $child_meta, "different metaclass instances for the two classes"); |
88 | |
89 | is_deeply([$child_meta->superclasses], ['Class'], "correct superclasses"); |
8e64d0fa |
90 | |
91 | |
92 | ok($child_meta->has_attribute('bishop')); |
93 | ok($child_meta->has_method('child_method')); |
94 | |
95 | |
96 | is( join(' ', sort $child_meta->get_method_list), |
97 | join(' ', sort qw(meta bishop child_method)) |
98 | ); |
612d3e1a |
99 | |
100 | can_ok($child_meta, 'find_method_by_name'); |
101 | is $child_meta->find_method_by_name('child_method')->fully_qualified_name, 'Child::child_method'; |
102 | is $child_meta->find_method_by_name('pawn')->fully_qualified_name, 'Class::pawn'; |
103 | |
104 | |
105 | is( join(' ', sort map{ $_->fully_qualified_name } grep{ $_->package_name ne 'Mouse::Object' } $child_meta->get_all_methods), |
106 | join(' ', sort qw( |
107 | Child::bishop Child::child_method Child::meta |
108 | |
109 | Class::MY_CONST Class::has_pawn Class::pawn Class::stub Class::stub_with_attr |
110 | )) |
111 | ); |