line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Eve::Test; |
2
|
|
|
|
|
|
|
|
3
|
43
|
|
|
43
|
|
81447
|
use strict; |
|
43
|
|
|
|
|
83
|
|
|
43
|
|
|
|
|
1332
|
|
4
|
43
|
|
|
43
|
|
215
|
use warnings; |
|
43
|
|
|
|
|
71
|
|
|
43
|
|
|
|
|
3155
|
|
5
|
|
|
|
|
|
|
|
6
|
43
|
|
|
43
|
|
193
|
use parent qw(Test::Class); |
|
43
|
|
|
|
|
73
|
|
|
43
|
|
|
|
|
363
|
|
7
|
|
|
|
|
|
|
|
8
|
43
|
|
|
43
|
|
1922071
|
use Test::More; |
|
43
|
|
|
|
|
358923
|
|
|
43
|
|
|
|
|
428
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 NAME |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
B - a base class for all test cases. |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 SYNOPSIS |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
use parent qw(Eve::Test); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub startup : Test(startup) { |
19
|
|
|
|
|
|
|
my $self = shift; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
$self->{'testcase_property'} = 'Testcase'; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub setup : Test(setup) { |
25
|
|
|
|
|
|
|
my $self = shift; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
$self->{'test_property'} = 'Test'; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub test_match : Test(2) { |
31
|
|
|
|
|
|
|
my $self = shift; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
is($something, $self->{'testcase_property'}, |
34
|
|
|
|
|
|
|
'Does something equal a testcase property?'); |
35
|
|
|
|
|
|
|
is($something, $self->{'test_property'}, |
36
|
|
|
|
|
|
|
'Does something equal a test property?'); |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
Eve::Test::is_lazy( |
39
|
|
|
|
|
|
|
code => sub { |
40
|
|
|
|
|
|
|
return $self->{'some_registry'}->get_some_lazy_service(); |
41
|
|
|
|
|
|
|
}, |
42
|
|
|
|
|
|
|
class_name => 'Some::Lazy::Service', |
43
|
|
|
|
|
|
|
description => |
44
|
|
|
|
|
|
|
'Does the subroutine return the same instance of ' |
45
|
|
|
|
|
|
|
. 'Some::Lazy::Service?'); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
Eve::Test::is_prototype( |
48
|
|
|
|
|
|
|
code => sub { |
49
|
|
|
|
|
|
|
return $self->{'some_registry'}->get_some_prototype_service(); |
50
|
|
|
|
|
|
|
}, |
51
|
|
|
|
|
|
|
class_name => 'Some::Prototype::Service', |
52
|
|
|
|
|
|
|
description => |
53
|
|
|
|
|
|
|
'Does the subroutine return a different instance of ' |
54
|
|
|
|
|
|
|
. 'Some::Prototype::Service?'); |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub setup : Test(teardown) { |
58
|
|
|
|
|
|
|
my $self = shift; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
undef $self->{'test_property'}; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub shutdown : Test(shutdown) { |
64
|
|
|
|
|
|
|
my $self = shift; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
undef $self->{'testcase_property'}; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 DESCRIPTION |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
B class uses the L module as a base. Each |
72
|
|
|
|
|
|
|
test case that wants to use its functionality should inherit from it. |
73
|
|
|
|
|
|
|
After this it is easy to define setup/teardown, startup/shutdown and |
74
|
|
|
|
|
|
|
test methods. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head2 Test methods |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
A test method is specified as such by using special method attributes |
79
|
|
|
|
|
|
|
like so: |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub test_something : Test { |
82
|
|
|
|
|
|
|
# Your test here |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
If there is more than one test in the method, their count should be |
86
|
|
|
|
|
|
|
specified: |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub test_something : Test(4) { |
89
|
|
|
|
|
|
|
# Your four tests here |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
If there is no way to tell how many tests are going to be run in the |
93
|
|
|
|
|
|
|
method, the 'no_plan' parameter can be used: |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub test_something : Test(no_plan) { |
96
|
|
|
|
|
|
|
# Your test here |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head2 Abstract test classes |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
To avoid running tests on abstract test classes call the SKIP_CLASS |
102
|
|
|
|
|
|
|
method in the package. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
Eve::SomeAbstractClassTest->SKIP_CLASS(1); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=cut |
107
|
|
|
|
|
|
|
|
108
|
17
|
|
|
17
|
|
953
|
INIT { Test::Class->runtests() } |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head1 METHODS |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head2 B |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Asserts that a code block returns the same object on two sequential |
115
|
|
|
|
|
|
|
calls and that this object is an instance of a certain class. When |
116
|
|
|
|
|
|
|
using this assertion method add two tests to the plan for each call. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
use Eve::Test; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub test_lazy_service : Test(2) { |
121
|
|
|
|
|
|
|
Eve::Test::is_lazy( |
122
|
|
|
|
|
|
|
code => sub { |
123
|
|
|
|
|
|
|
return $some_registry->some_lazy_service(); |
124
|
|
|
|
|
|
|
}, |
125
|
|
|
|
|
|
|
class_name => 'Some::Class::Name', |
126
|
|
|
|
|
|
|
description => 'I need this service to be lazy!'); |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=head3 Arguments |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=over 4 |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=item C |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=item C |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=item C |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
(optional) defaults to undef. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=back |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=cut |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub is_lazy { |
146
|
0
|
|
|
0
|
1
|
|
my (%arg_hash) = @_; |
147
|
0
|
|
|
|
|
|
Eve::Support::arguments(\%arg_hash, |
148
|
|
|
|
|
|
|
my ($code, $class_name), my $description = \undef); |
149
|
|
|
|
|
|
|
|
150
|
0
|
|
|
|
|
|
isa_ok($code->(), $class_name, $description); |
151
|
0
|
|
|
|
|
|
is($code->(), $code->(), $description); |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
|
return; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head2 B |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
Asserts that a code block returns a different object on two sequential |
159
|
|
|
|
|
|
|
calls and that this object is an instance of a certain class. When |
160
|
|
|
|
|
|
|
using this assertion method add two tests to the plan for each call. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
use Eve::Test; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub test_prototype_service : Test(2) { |
165
|
|
|
|
|
|
|
Eve::Test::is_prototype( |
166
|
|
|
|
|
|
|
code => sub { |
167
|
|
|
|
|
|
|
return $some_registry->some_prototype_service(); |
168
|
|
|
|
|
|
|
}, |
169
|
|
|
|
|
|
|
class_name => 'Some::Class::Name', |
170
|
|
|
|
|
|
|
description => 'I need this service to be a prototype!'); |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=head3 Arguments |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=over 4 |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=item C |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=item C |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=item C |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
(optional) defaults to undef. |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=back |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=cut |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub is_prototype { |
190
|
0
|
|
|
0
|
1
|
|
my (%arg_hash) = @_; |
191
|
0
|
|
|
|
|
|
Eve::Support::arguments(\%arg_hash, |
192
|
|
|
|
|
|
|
my ($code, $class_name), my $description = \undef); |
193
|
|
|
|
|
|
|
|
194
|
0
|
|
|
|
|
|
isa_ok($code->(), $class_name, $description); |
195
|
0
|
|
|
|
|
|
isnt($code->(), $code->(), $description); |
196
|
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
return; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=head1 SEE ALSO |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=over 4 |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=item L |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=item L |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=item L |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=item L |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=item L |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=back |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Copyright 2012 Igor Zinovyev. |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
221
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
222
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=head1 AUTHORS |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=over 4 |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=item L |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=item L |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=cut |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
1; |