File Coverage

blib/lib/Test/Run/Obj/TestObj.pm
Criterion Covered Total %
statement 55 56 98.2
branch 9 10 90.0
condition 11 12 91.6
subroutine 22 22 100.0
pod 12 12 100.0
total 109 112 97.3


line stmt bran cond sub pod time code
1             package Test::Run::Obj::TestObj;
2              
3 8     8   55 use strict;
  8         19  
  8         390  
4 8     8   49 use warnings;
  8         13  
  8         547  
5              
6             =head1 NAME
7              
8             Test::Run::Obj::TestObj - results of a single test script.
9              
10             =cut
11              
12 8     8   50 use vars qw(@fields);
  8         20  
  8         668  
13              
14 8     8   49 use Moose;
  8         17  
  8         138  
15              
16             extends('Test::Run::Base::Struct');
17              
18 8     8   49577 use MRO::Compat;
  8         17  
  8         90  
19              
20 8     8   303 use Test::Run::Obj::IntOrUnknown;
  8         17  
  8         246  
21              
22             =head1 FIELDS
23              
24             =head2 $self->bonus()
25              
26             Number of TODO tests that unexpectedly passed.
27              
28             =head2 $self->failed()
29              
30             Returns an array reference containing list of test numbers that failed.
31              
32             =head2 $self->ok()
33              
34             Number of tests that passed.
35              
36             =head2 $self->next()
37              
38             The next expected event.
39              
40             =head2 $self->max()
41              
42             The number of plannedt tests.
43              
44             =head2 $self->skipped()
45              
46             The number of skipped tests.
47              
48             =head2 $self->skip_all()
49              
50             This field will contain the reason for why the entire test script was skipped,
51             in cases when it was.
52              
53             =head2 $self->skip_reason()
54              
55             The skip reason for the last skipped test that specified such a reason.
56              
57             =cut
58              
59             has 'bonus' => (is => "rw", isa => "Num");
60             has 'failed' => (is => "rw", isa => "ArrayRef");
61             has 'max' => (is => "rw", isa => "Num");
62             has 'ml' => (is => "rw", isa => "Str");
63             has 'next' => (is => "rw", isa => "Num");
64             has 'ok' => (is => "rw", isa => "Num");
65             has 'skip_all' => (is => "rw", isa => "Maybe[Str]");
66             has 'skipped' => (is => "rw", isa => "Num");
67             has 'skip_reason' => (is => "rw", isa => "Maybe[Str]");
68              
69             =head2 BUILD
70              
71             For Moose.
72              
73             =cut
74              
75             sub BUILD
76             {
77 55     55 1 709 my $self = shift;
78              
79 55         1405 $self->_register_obj_formatter(
80             {
81             name => "dont_know_which_tests_failed",
82             format => "Don't know which tests failed: got %(ok)s ok, expected %(max)s",
83             },
84             );
85              
86 55         213 return;
87             }
88              
89             =head2 $self->add_to_failed(@failures)
90              
91             Add failures to the failed() slot.
92              
93             =cut
94              
95             sub add_to_failed
96             {
97 21     21 1 62 my $self = shift;
98 21         40 push @{$self->failed()}, @_;
  21         719  
99             }
100              
101             sub _get_reason_default
102             {
103 1     1   35 return "no reason given";
104             }
105              
106             =head2 $self->get_reason()
107              
108             Gets the reason or defaults to the default.
109              
110             =cut
111              
112             sub get_reason
113             {
114 3     3 1 13 my $self = shift;
115              
116             return
117 3 100 66     157 +(defined($self->skip_all()) && length($self->skip_all())) ?
118             $self->skip_all() :
119             $self->_get_reason_default()
120             ;
121             }
122              
123             =head2 $self->num_failed()
124              
125             Returns the number of failed tests.
126              
127             =cut
128              
129             sub num_failed
130             {
131 24     24 1 73 my $self = shift;
132              
133 24         55 return scalar(@{$self->failed()});
  24         720  
134             }
135              
136             =head2 $self->calc_percent()
137              
138             Calculates the percent of failed tests.
139              
140             =cut
141              
142             sub calc_percent
143             {
144 12     12 1 1200 my $self = shift;
145              
146 12         41 return ( (100*$self->num_failed()) / $self->max() );
147             }
148              
149             =head2 $self->add_next_to_failed()
150              
151             Adds the tests from ->next() to ->max() to the list of failed tests.
152              
153             =cut
154              
155             sub add_next_to_failed
156             {
157 2     2 1 13 my $self = shift;
158              
159 2         66 return $self->add_to_failed($self->next() .. $self->max());
160             }
161              
162             =head2 $self->is_failed_and_max()
163              
164             Returns if there are failed tests B<and> the maximal test number was set.
165              
166             =cut
167              
168             sub is_failed_and_max
169             {
170 24     24 1 63 my $self = shift;
171              
172 24   100     57 return scalar(@{$self->failed()}) && $self->max();
173             }
174              
175             sub _get_dont_know_which_tests_failed_msg
176             {
177 2     2   10 my $self = shift;
178              
179 2         24 return $self->_format_self("dont_know_which_tests_failed");
180             }
181              
182             =head2 $self->skipped_or_bonus()
183              
184             Returns whether the test file is either skipped() or bonus().
185              
186             =cut
187              
188             sub skipped_or_bonus
189             {
190 33     33 1 148 my $self = shift;
191              
192 33   100     1206 return $self->skipped() || $self->bonus();
193             }
194              
195             =head2 $self->all_succesful()
196              
197             A predicate that calculates if all the tests in the TestObj were successful.
198              
199             =cut
200              
201             sub all_succesful
202             {
203 3     3 1 19 my $self = shift;
204              
205             return
206             (
207             ($self->next() == $self->max() + 1)
208             &&
209 3   100     102 (! @{$self->failed()})
210             );
211             }
212              
213             =head2 $self->get_dubious_summary_main_obj_method()
214              
215             Returns the method name of the main object that should be propagated
216             based on the success/failure status of this test object.
217              
218             =cut
219              
220             sub get_dubious_summary_main_obj_method
221             {
222 6     6 1 28 my $self = shift;
223              
224             return
225 6 100       173 $self->max()
    100          
226             ? ($self->all_succesful()
227             ? "_get_dubious_summary_all_subtests_successful"
228             : "_get_premature_test_dubious_summary"
229             )
230             : "_get_no_tests_summary"
231             ;
232             }
233              
234             =head2 $self->get_failed_obj_params
235              
236             Returns a key value array ref of params for initializing the failed-object.
237              
238             =cut
239              
240             sub get_failed_obj_params
241             {
242 6     6 1 31 my $self = shift;
243              
244             return
245             [
246 6 100       179 max => ($self->max()
247             ? Test::Run::Obj::IntOrUnknown->create_int($self->max())
248             : Test::Run::Obj::IntOrUnknown->create_unknown()
249             ),
250             ];
251             }
252              
253             sub _still_running
254             {
255 19     19   79 my $self = shift;
256              
257 19         658 return ($self->next() <= $self->max());
258             }
259              
260              
261             sub _calc_tests_as_failures
262             {
263 19     19   108 my ($self, $details) = @_;
264              
265 19 50       145 if ($self->_still_running())
266             {
267 0         0 return [$self->next() .. $self->max()];
268             }
269             else
270             {
271             return
272             [
273 19         480 grep { ref($details->[$_-1]) }
  100009         116432  
274             (($self->max()+1) .. @$details)
275             ];
276             }
277             }
278              
279             =head2 $self->list_tests_as_failures($last_test_results->details())
280              
281             Lists the tests as failures where appropriate.
282              
283             =cut
284              
285             sub list_tests_as_failures
286             {
287 19     19 1 77 my ($self, $details) = @_;
288              
289 19         64 $self->add_to_failed(@{$self->_calc_tests_as_failures($details)});
  19         193  
290             }
291              
292             1;
293              
294             __END__
295              
296             =head1 SEE ALSO
297              
298             L<Test::Run::Base::Struct>, L<Test::Run::Obj>, L<Test::Run::Core>
299              
300             =head1 LICENSE
301              
302             This file is freely distributable under the MIT X11 license.
303              
304             L<http://www.opensource.org/licenses/mit-license.php>
305              
306             =head1 AUTHOR
307              
308             Shlomi Fish, L<http://www.shlomifish.org/>.
309              
310             =cut
311