File Coverage

blib/lib/Test2/Harness/Job.pm
Criterion Covered Total %
statement 93 93 100.0
branch 35 38 92.1
condition 9 14 64.2
subroutine 18 18 100.0
pod 4 6 66.6
total 159 169 94.0


line stmt bran cond sub pod time code
1             package Test2::Harness::Job;
2 25     25   229053 use strict;
  25         28  
  25         714  
3 25     25   96 use warnings;
  25         24  
  25         1322  
4              
5             our $VERSION = '0.000012';
6              
7 25     25   117 use Carp qw/croak/;
  25         26  
  25         1274  
8 25     25   1021 use Time::HiRes qw/time/;
  25         2040  
  25         124  
9 25         212 use Test2::Util::HashBase qw{
10             id file listeners parser proc result _done _timeout
11             _timeout_notified
12 25     25   2779 };
  25         25  
13              
14 25     25   18493 use Test2::Event::ParseError;
  25         48  
  25         465  
15 25     25   7620 use Test2::Event::ProcessStart;
  25         47  
  25         659  
16 25     25   8319 use Test2::Event::ProcessFinish;
  25         48  
  25         662  
17 25     25   7785 use Test2::Event::Subtest;
  25         26567  
  25         468  
18 25     25   22482 use Test2::Event::TimeoutReset;
  25         29  
  25         463  
19 25     25   7407 use Test2::Event::UnexpectedProcessExit;
  25         26  
  25         444  
20 25     25   7575 use Test2::Harness::Result;
  25         25  
  25         12785  
21              
22             sub init {
23 645     645 0 331342 my $self = shift;
24              
25             croak "job 'id' is required"
26 645 100       2584 unless $self->{+ID};
27              
28             croak "job 'file' is required"
29 643 100       1705 unless $self->{+FILE};
30              
31 641   100     1699 $self->{+LISTENERS} ||= [];
32              
33             $self->{+RESULT} ||= Test2::Harness::Result->new(
34             file => $self->{+FILE},
35             name => $self->{+FILE},
36 641   33     8436 job => $self->{+ID},
37             );
38             }
39              
40             sub start {
41 627     627 1 983 my $self = shift;
42 627         2032 my %params = @_;
43              
44 627         1207 my $id = $self->{+ID};
45 627         1905 my ($runner, $start_args, $parser_class) = @params{qw/runner start_args parser_class/};
46              
47             my ($proc, @events) = $runner->start(
48 627         5044 $self->{+FILE},
49             %$start_args,
50             job => $id,
51             );
52              
53 607 50       38713 die "Failed to get a proc object" unless $proc;
54              
55 607         7341 my $parser = $parser_class->new(
56             job => $id,
57             proc => $proc,
58             );
59              
60 607 50       2643 die "Failed to get a parser object" unless $parser;
61              
62 607         2267 $self->{+PROC} = $proc;
63 607         1136 $self->{+PARSER} = $parser;
64              
65 607         7852 my $start = Test2::Event::ProcessStart->new(file => $self->{+FILE});
66 607         4465 $self->notify($start, @events);
67             }
68              
69             sub notify {
70 35060     35060 1 38180 my $self = shift;
71 35060         37821 my (@events) = @_;
72              
73 35060 100       67029 return unless @events;
74              
75 15606         24044 for my $e (@events) {
76 19859         15467 $_->($self, $e) for @{$self->{+LISTENERS}};
  19859         64678  
77             }
78             # The ProcessFinish event contains a reference to the result, so if we add
79             # that event to the result we end up with a circular ref.
80 15606         20642 $self->{+RESULT}->add_events(grep { !$_->isa('Test2::Event::ProcessFinish') } @events);
  19859         85211  
81             }
82              
83             sub step {
84 33776     33776 1 53410 my $self = shift;
85 33776         129302 my @events = $self->{+PARSER}->step;
86 33776         97350 $self->notify(@events);
87 33776 100 66     153940 if (@events && $self->{+_TIMEOUT}) {
88 48         137 delete $self->{+_TIMEOUT};
89             $self->notify(Test2::Event::TimeoutReset->new(file => $self->{+FILE}))
90 48 50       435 if $self->{+_TIMEOUT_NOTIFIED};
91             }
92 33776 100       130007 return @events ? 1 : 0;
93             }
94              
95             sub timeout {
96 2339     2339 0 7617 my $self = shift;
97              
98             # No timeout if the process exits badly
99 2339 100       12547 return 0 if $self->{+PROC}->exit;
100              
101 2337         15227 my $r = $self->{+RESULT};
102 2337         10199 my $plans = $r->plans;
103              
104 2337 100 66     26875 if ($plans && @$plans) {
105 613         1682 my $plan = $plans->[0];
106 613         2653 my $max = ($plan->sets_plan)[0];
107              
108 613 100       4184 return 0 unless $max;
109 573 100       3101 return 0 if $max == $r->total;
110             }
111              
112             # 60 seconds if all else fails.
113 1726         7392 return 60;
114             }
115              
116             sub is_done {
117 28178     28178 1 29846 my $self = shift;
118              
119 28178 100       54091 return 1 if $self->{+_DONE};
120              
121 28176         33040 my $proc = $self->{+PROC};
122 28176 100       73932 return 0 unless $proc->is_done;
123              
124             # If the process finished but forked a subprocess that is still producing
125             # output, then we might see something when we call ->step. This is fairly
126             # pathological, but we try to handle it.
127 5618 100       12071 return 0 if $self->step;
128              
129 2337 100       10538 if (my $timeout = $self->timeout) {
130 1730 100       6891 unless ($self->{+_TIMEOUT}) {
131 50         251 $self->{+_TIMEOUT} = time;
132              
133             $self->notify(
134             Test2::Event::UnexpectedProcessExit->new(
135             error => "Process has exited but the event stream does not appear complete. Waiting $timeout seconds...",
136             file => $self->{+FILE},
137             ),
138 50 100 66     600 ) if $timeout >= 1 && !$self->{+_TIMEOUT_NOTIFIED}++;
139              
140 50         445 return 0;
141             }
142              
143 1680 100       17571 return 0 if $timeout > (time - $self->{+_TIMEOUT});
144             }
145              
146 609         4345 $self->{+_DONE} = 1;
147              
148 609         1782 $self->{+RESULT}->stop($proc->exit);
149              
150 609         2616 $self->notify(Test2::Event::ProcessFinish->new(file => $proc->file, result => $self->{+RESULT}));
151              
152 609         2879 return 1;
153             }
154              
155             1;
156              
157             __END__