Commit | Line | Data |
ddd87d75 |
1 | package MooseClass::Tests; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Lingua::EN::Inflect qw( PL_N ); |
7 | use Test::More 'no_plan'; |
8 | |
9 | sub tests01 { |
10 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
11 | |
12 | has_meta('Person'); |
13 | |
14 | check_isa( 'Person', ['Moose::Object'] ); |
15 | |
16 | count_attrs( 'Person', 2 ); |
17 | |
18 | has_rw_attr( 'Person', $_ ) for qw( first_name last_name ); |
19 | |
20 | has_method( 'Person', 'full_name' ); |
21 | |
22 | no_droppings('Person'); |
23 | is_immutable('Person'); |
24 | |
25 | person01(); |
26 | |
27 | has_meta('Employee'); |
28 | |
29 | check_isa( 'Employee', [ 'Person', 'Moose::Object' ] ); |
30 | |
31 | count_attrs( 'Employee', 3 ); |
32 | |
33 | has_rw_attr( 'Employee', $_ ) for qw( position salary ); |
34 | has_ro_attr( 'Employee', 'ssn' ); |
35 | |
36 | has_overridden_method( 'Employee', 'full_name' ); |
37 | |
38 | employee01(); |
39 | } |
40 | |
41 | sub has_meta { |
42 | my $class = shift; |
43 | |
44 | ok( $class->can('meta'), "$class has a meta() method" ) |
45 | or BAIL_OUT("Cannot run tests against a class without a meta!"); |
46 | } |
47 | |
48 | sub check_isa { |
49 | my $class = shift; |
50 | my $parents = shift; |
51 | |
52 | my @isa = $class->meta->linearized_isa; |
53 | shift @isa; # returns $class as the first entry |
54 | |
55 | my $count = scalar @{$parents}; |
56 | my $noun = PL_N( 'parent', $count ); |
57 | |
58 | is( scalar @isa, $count, "$class has $count $noun" ); |
59 | |
60 | for ( my $i = 0; $i < @{$parents}; $i++ ) { |
61 | is( $isa[$i], $parents->[$i], "parent[$i] is $parents->[$i]" ); |
62 | } |
63 | } |
64 | |
65 | sub count_attrs { |
66 | my $class = shift; |
67 | my $count = shift; |
68 | |
69 | my $noun = PL_N( 'attribute', $count ); |
70 | is( scalar $class->meta->get_attribute_list, $count, |
71 | "$class defines $count $noun" ); |
72 | } |
73 | |
74 | sub has_rw_attr { |
75 | my $class = shift; |
76 | my $name = shift; |
77 | |
78 | ok( $class->meta->has_attribute($name), "$class has attribute - $name" ); |
79 | |
80 | my $attr = $class->meta->get_attribute($name); |
81 | |
82 | is( $attr->get_read_method, $name, |
83 | "$name attribute has a reader accessor - $name()" ); |
84 | is( $attr->get_write_method, $name, |
85 | "$name attribute has a writer accessor - $name()" ); |
86 | } |
87 | |
88 | sub has_ro_attr { |
89 | my $class = shift; |
90 | my $name = shift; |
91 | |
92 | ok( $class->meta->has_attribute($name), "$class has attribute - $name" ); |
93 | |
94 | my $attr = $class->meta->get_attribute($name); |
95 | |
96 | is( $attr->get_read_method, $name, |
97 | "$name attribute has a reader accessor - $name()" ); |
98 | is( $attr->get_write_method, undef, |
99 | "$name attribute does not have a writer" ); |
100 | } |
101 | |
102 | sub has_method { |
103 | my $class = shift; |
104 | my $name = shift; |
105 | |
106 | ok( $class->meta->has_method($name), "$class has a $name method" ); |
107 | } |
108 | |
109 | sub has_overridden_method { |
110 | my $class = shift; |
111 | my $name = shift; |
112 | |
113 | ok( $class->meta->has_method($name), "$class has a $name method" ); |
114 | |
115 | my $meth = $class->meta->get_method($name); |
116 | isa_ok( $meth, 'Moose::Meta::Method::Overridden' ); |
117 | } |
118 | |
119 | sub no_droppings { |
120 | my $class = shift; |
121 | |
122 | ok( !$class->can('has'), "no Moose droppings in $class" ); |
123 | } |
124 | |
125 | sub is_immutable { |
126 | my $class = shift; |
127 | |
128 | ok( $class->meta->is_immutable, "$class has been made immutable" ); |
129 | } |
130 | |
131 | sub person01 { |
132 | my $person = Person->new( |
133 | first_name => 'Bilbo', |
134 | last_name => 'Baggins', |
135 | ); |
136 | |
137 | is( $person->full_name, 'Bilbo Baggins', |
138 | 'full_name() is correctly implemented' ); |
139 | } |
140 | |
141 | sub employee01 { |
142 | my $employee = Employee->new( |
143 | first_name => 'Amanda', |
144 | last_name => 'Palmer', |
145 | position => 'Singer', |
146 | ); |
147 | |
148 | is( $employee->full_name, 'Amanda Palmer (Singer)', |
149 | 'full_name() is properly overriden in Employee' ); |
150 | } |
151 | |
152 | |
153 | 1; |