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