File Coverage

blib/lib/Test/Run/Straps/StrapsTotalsObj.pm
Criterion Covered Total %
statement 115 120 95.8
branch 22 26 84.6
condition 15 18 83.3
subroutine 38 39 97.4
pod 7 7 100.0
total 197 210 93.8


line stmt bran cond sub pod time code
1             package Test::Run::Straps::StrapsTotalsObj;
2              
3 14     14   82 use strict;
  14         31  
  14         421  
4 14     14   80 use warnings;
  14         31  
  14         523  
5              
6             =head1 NAME
7              
8             Test::Run::Straps::StrapsTotalsObj - an object representing the totals of the
9             straps class.
10              
11             =head1 FIELDS
12              
13             =cut
14              
15 14     14   7360 use Test::Run::Straps::StrapsDetailsObj;
  14         51  
  14         566  
16              
17 14     14   119 use Moose;
  14         31  
  14         85  
18              
19             extends('Test::Run::Straps::Base');
20              
21             has 'bonus' => (is => "rw", isa => "Num");
22             has 'details' => (is => "rw", isa => "ArrayRef");
23             has '_enormous_num_cb' => (is => "rw", isa => "Maybe[CodeRef]");
24             has 'exit' => (is => "rw", isa => "Num");
25             has 'filename' => (is => "rw", isa => "Str");
26             has '_is_vms' => (is => "rw", isa => "Bool");
27             has 'max' => (is => "rw", isa => "Num");
28             has 'ok' => (is => "rw", isa => "Num");
29             has 'passing' => (is => "rw", isa => "Bool");
30             has 'seen' => (is => "rw", isa => "Num");
31             has 'skip' => (is => "rw", isa => "Num");
32             has 'skip_all' => (is => "rw", isa => "Str");
33             has 'skip_reason' => (is => "rw", isa => "Str");
34             has 'todo' => (is => "rw", isa => "Num");
35             has 'wait' => (is => "rw", isa => "Num");
36              
37             =head1 METHODS
38              
39             =head2 $self->_calc_passing()
40              
41             Calculates whether the test file has passed.
42              
43             =cut
44              
45             sub _is_skip_all
46             {
47 55     55   118 my $self = shift;
48              
49 55   100     2305 return (($self->max() == 0) && defined($self->skip_all()));
50             }
51              
52             sub _is_all_tests_passed
53             {
54 52     52   130 my $self = shift;
55              
56             return
57             (
58 52   100     2079 $self->max && $self->seen
59             && ($self->max == $self->seen)
60             && ($self->max == $self->ok)
61             );
62             }
63              
64             sub _calc_passing
65             {
66 55     55   114 my $self = shift;
67              
68 55   100     308 return ($self->_is_skip_all() || $self->_is_all_tests_passed());
69             }
70              
71             =head2 $self->determine_passing()
72              
73             Calculates whether the test file has passed and caches it in the passing()
74             slot.
75              
76             =cut
77              
78             sub determine_passing
79             {
80 55     55 1 116 my $self = shift;
81 55 100       231 $self->passing($self->_calc_passing() ? 1 : 0);
82             }
83              
84             =head2 $self->last_detail()
85              
86             Returns the last detail.
87              
88             =cut
89              
90             sub last_detail
91             {
92 442     442 1 680 my $self = shift;
93              
94 442         17932 return $self->details->[-1];
95             }
96              
97             sub _calc_enormous_event_num
98             {
99 208     208   299 my $self = shift;
100              
101 208         440 return 100_000;
102             }
103              
104             sub _is_enormous_event_num
105             {
106 208     208   321 my $self = shift;
107              
108 208         684 my $large_num = $self->_calc_enormous_event_num();
109              
110             return
111 208   66     8026 +($self->_event->number > $large_num)
112             &&
113             ($self->_event->number > ($self->max || $large_num))
114             ;
115             }
116              
117             sub _init_details_obj_instance
118             {
119 201     201   503 my ($self, $args) = @_;
120 201         1358 return Test::Run::Straps::StrapsDetailsObj->new($args);
121             }
122              
123             sub _handle_event_main
124             {
125 208     208   334 my $self = shift;
126              
127 208         656 $self->_inc_seen();
128 208         699 $self->_update_by_labeled_test_event();
129 208         747 $self->_update_if_pass();
130 208         707 $self->_update_details_wrapper();
131             }
132              
133             sub _def_or_blank
134             {
135 804     804   1167 my $value = shift;
136              
137 804 100       4444 return defined($value) ? $value : "";
138             }
139              
140             sub _defined_hash_values
141             {
142 201     201   3718 my ($self, $hash) = @_;
143              
144             return
145             {
146             map
147 201         746 { $_ => _def_or_blank($hash->{$_}) }
  804         1661  
148             keys(%$hash)
149             };
150             }
151              
152             sub _calc_always_def_details_initializer
153             {
154 201     201   324 my $self = shift;
155              
156 201         7428 my $event = $self->_event;
157              
158             return
159             {
160 201         677 actual_ok => scalar($event->is_ok()),
161             name => $event->description,
162             type => lc($event->directive),
163             reason => $event->explanation,
164             };
165             }
166              
167             sub _calc_defined_details
168             {
169 201     201   330 my $self = shift;
170              
171 201         543 $self->_defined_hash_values(
172             $self->_calc_always_def_details_initializer()
173             );
174             }
175              
176             sub _calc_details
177             {
178 201     201   299 my $self = shift;
179              
180             return
181             $self->_init_details_obj_instance(
182             {
183             ok => $self->_is_event_pass(),
184 201         692 %{$self->_calc_defined_details()},
  201         589  
185             }
186             );
187             }
188              
189             sub _update_details
190             {
191 201     201   366 my ($self) = @_;
192              
193 201         541 $self->details->[$self->_event->number - 1] = $self->_calc_details();
194              
195 201         5933 return ;
196             }
197              
198             sub _update_skip_event
199             {
200 5     5   17 my $self = shift;
201              
202 5         32 $self->inc_field('skip');
203              
204 5         22 return;
205             }
206              
207             sub _update_if_pass
208             {
209 208     208   350 my $self = shift;
210              
211 208 100       900 if ($self->_is_event_pass())
212             {
213 178         608 $self->inc_field('ok');
214             }
215             }
216              
217             sub _handle_enormous_event_num
218             {
219 7     7   20 my $self = shift;
220              
221 7         353 return $self->_enormous_num_cb->();
222             }
223              
224             sub _update_todo_event
225             {
226 16     16   725 my $self = shift;
227              
228 16         64 $self->inc_field('todo');
229              
230 16 100       589 if ($self->_event->is_actual_ok())
231             {
232 8         176 $self->inc_field('bonus');
233             }
234              
235 16         177 return;
236             }
237              
238              
239             sub _inc_seen
240             {
241 208     208   331 my $self = shift;
242              
243 208         855 $self->inc_field('seen');
244             }
245              
246             =head2 $self->handle_event({event => $event, enormous_num_cb => sub {...}});
247              
248             Updates the state of the details using a new TAP::Parser event - $event .
249             C<enormous_num_cb> points to a subroutine reference that is the callback for
250             handling enormous numbers.
251              
252             =cut
253              
254             sub _setup_event
255             {
256 208     208   352 my ($self, $args) = @_;
257              
258 208         7773 $self->_event($args->{event});
259 208         9306 $self->_enormous_num_cb($args->{enormous_num_cb});
260              
261 208         401 return ;
262             }
263              
264             sub _detach_event
265             {
266 208     208   382 my ($self) = @_;
267              
268 208         7620 $self->_event(undef);
269 208         9016 $self->_enormous_num_cb(undef);
270             }
271              
272             sub handle_event
273             {
274 208     208 1 427 my ($self, $args) = @_;
275              
276 208         1259 $self->_setup_event($args);
277              
278 208         931 $self->_handle_event_main();
279              
280 208         850 $self->_detach_event();
281             }
282              
283             sub _update_details_wrapper
284             {
285 208     208   348 my $self = shift;
286              
287 208 100       763 if ($self->_is_enormous_event_num())
288             {
289 7         29 $self->_handle_enormous_event_num();
290             }
291             else
292             {
293 201         3840 $self->_update_details();
294             }
295             }
296              
297             sub _update_by_labeled_test_event
298             {
299 208     208   330 my $self = shift;
300              
301 208 100       7677 if ($self->_event->has_todo())
    100          
302             {
303 16         371 $self->_update_todo_event();
304             }
305             elsif ($self->_event->has_skip())
306             {
307 5         130 $self->_update_skip_event();
308             }
309              
310 208         3061 return;
311             }
312              
313             =head2 $self->update_skip_reason($detail)
314              
315             Updates the skip reason according to the detail $detail.
316              
317             =cut
318              
319             sub _get_skip_reason
320             {
321 5     5   15 my ($self, $detail) = @_;
322              
323 5 50       257 if (!defined($self->skip_reason))
    0          
324             {
325 5         228 return $detail->reason();
326             }
327             elsif ($self->skip_reason ne $detail->reason())
328             {
329 0         0 return "various reasons";
330             }
331             else
332             {
333 0         0 return $self->skip_reason;
334             }
335             }
336              
337             sub _real_update_skip_reason
338             {
339 5     5   17 my ($self, $detail) = @_;
340              
341 5         28 $self->skip_reason($self->_get_skip_reason($detail));
342             }
343              
344             sub update_skip_reason
345             {
346 180     180 1 323 my ($self, $detail) = @_;
347              
348 180 100       7394 if ($detail->type eq "skip")
349             {
350 5         32 $self->_real_update_skip_reason($detail);
351             }
352             }
353              
354             sub _get_failed_details
355             {
356 55     55   133 my $self = shift;
357              
358 55         2222 my $details = $self->details;
359              
360 55         5573 return [ grep {! $details->[$_-1]->{ok} } (1 .. @$details) ];
  100188         211624  
361             }
362              
363             =head2 $self->get_failed_obj_params
364              
365             Returns a key value array ref of params for initializing the failed-object.
366              
367             =cut
368              
369             sub get_failed_obj_params
370             {
371 6     6 1 20 my $self = shift;
372              
373             return
374             [
375 6         248 estat => $self->exit(),
376             wstat => $self->wait(),
377             name => $self->filename(),
378             ];
379             }
380              
381             =head2 $self->update_based_on_last_detail()
382              
383             Check if the last_detail is OK, and if so update the skip_reason
384             based on it.
385              
386             =cut
387              
388             sub update_based_on_last_detail
389             {
390 208     208 1 346 my $self = shift;
391              
392 208         642 my $detail = $self->last_detail();
393              
394 208 100       8798 if ( $detail->ok() )
395             {
396 180         584 $self->update_skip_reason($detail);
397             }
398              
399 208         556 return;
400             }
401              
402             =head2 $self->in_the_middle()
403              
404             Checks if the tests are in the middle - already some were seen but the
405             end was not reached.
406              
407             =cut
408              
409             sub in_the_middle
410             {
411 52     52 1 126 my $self = shift;
412              
413 52   66     2561 return ($self->seen() && ($self->seen() > $self->max()));
414             }
415              
416             sub _wait2exit_POSIX
417             {
418 55     55   121 my ($self, $wait) = @_;
419              
420 55         2486 return POSIX::WEXITSTATUS($wait);
421             }
422              
423             sub _wait2exit_no_POSIX
424             {
425 0     0   0 my ($self, $wait) = @_;
426              
427 0         0 return ($wait >> 8);
428             }
429              
430             eval { require POSIX; POSIX::WEXITSTATUS($?); };
431              
432             *_wait2exit = ($@ ? \&_wait2exit_no_POSIX : \&_wait2exit_POSIX);
433              
434             sub _calc_all_process_status
435             {
436 55     55   119 my $self = shift;
437              
438             # TODO - factor out the code.
439 55         2316 $self->wait($?);
440              
441 55 50 66     2205 if ($self->wait() && $self->_is_vms())
442             {
443 0         0 eval q{use vmsish "status"; $self->exit($?);};
444             }
445             else
446             {
447 55         2188 $self->exit($self->_wait2exit($self->wait()));
448             }
449             # It is possible $? is set agains because of the use vmsish
450             # call.
451 55 100       217 if ($? != 0)
452             {
453 6         268 $self->passing(0);
454             }
455              
456 55         137 return;
457             }
458              
459             =head2 $self->bonus()
460              
461             Number of TODO tests that unexpectedly passed.
462              
463             =head2 $self->details()
464              
465             An array containing the details of the individual checks in the test file.
466              
467             =head2 $self->exit()
468              
469             The exit code of the test script.
470              
471             =head2 $self->filename()
472              
473             The filename of the test script.
474              
475             =head2 $self->max()
476              
477             The number of planned tests.
478              
479             =head2 $self-ok()
480              
481             The number of tests that passed.
482              
483             =head2 $self->passing()
484              
485             A boolean value that indicates whether the entire test script is considered
486             a success or not.
487              
488             =head2 $self->seen()
489              
490             The number of tests that were actually run.
491              
492             =head2 $self->skip()
493              
494             The number of skipped tests.
495              
496             =head2 $self->skip_all()
497              
498             This field will contain the reason for why the entire test script was skipped,
499             in cases when it was.
500              
501             =head2 $self->skip_reason()
502              
503             The skip reason for the last skipped test that specified such a reason.
504              
505             =head2 $self->todo()
506              
507             The number of "Todo" tests that were encountered.
508              
509             =head2 $self->wait()
510              
511             The wait code of the test script.
512              
513             =head1 SEE ALSO
514              
515             L<Test::Run::Base::Struct>, L<Test::Run::Obj>, L<Test::Run::Core>
516              
517             =head1 LICENSE
518              
519             This file is licensed under the MIT X11 License:
520              
521             http://www.opensource.org/licenses/mit-license.php
522              
523             =head1 AUTHOR
524              
525             Shlomi Fish, L<http://www.shlomifish.org/>.
526              
527             =cut
528              
529             1;
530