File Coverage

blib/lib/Test2/Harness/Renderer/JUnit.pm
Criterion Covered Total %
statement 31 182 17.0
branch 0 64 0.0
condition 0 42 0.0
subroutine 11 21 52.3
pod 5 5 100.0
total 47 314 14.9


line stmt bran cond sub pod time code
1             package Test2::Harness::Renderer::JUnit;
2              
3             # Test2::Harness itself requires 5.10.
4 2     2   401154 use 5.010000;
  2         16  
5 2     2   14 use strict;
  2         5  
  2         60  
6 2     2   13 use warnings;
  2         4  
  2         86  
7              
8             our $VERSION = '1.000003';
9              
10             # This is used frequently during development to determine what different events look like so we can determine how to capture test data.
11 2     2   1272 use Data::Dumper;
  2         13448  
  2         151  
12             $Data::Dumper::Sortkeys = 1;
13              
14 2     2   18 use File::Spec;
  2         4  
  2         43  
15 2     2   11 use POSIX ();
  2         4  
  2         37  
16 2     2   1306 use Storable qw/dclone/;
  2         6592  
  2         129  
17 2     2   1236 use XML::Generator ();
  2         19482  
  2         53  
18 2     2   16 use Carp ();
  2         4  
  2         80  
19              
20 2     2   958 BEGIN { require Test2::Harness::Renderer; our @ISA = ('Test2::Harness::Renderer') }
  2         3032  
21 2         12 use Test2::Harness::Util::HashBase qw{
22             -io -io_err
23             -formatter
24             -show_run_info
25             -show_job_info
26             -show_job_launch
27             -show_job_end
28             -times
29 2     2   17 };
  2         4  
30              
31             sub init {
32 0     0 1   my $self = shift;
33              
34 0           my $settings = $self->{ +SETTINGS };
35              
36 0           $self->{'xml'} = XML::Generator->new( ':pretty', ':std', 'escape' => 'always,high-bit,even-entities', 'encoding' => 'UTF-8' );
37              
38 0           $self->{'xml_content'} = [];
39              
40 0 0         $self->{'allow_passing_todos'} = $ENV{'ALLOW_PASSING_TODOS'} ? 1 : 0;
41 0   0       $self->{'junit_file'} //= $ENV{'JUNIT_TEST_FILE'} || 'junit.xml';
      0        
42              
43 0           $self->{'tests'} = {}; # We need a pointer to each test so we know where to go for each event.
44             }
45              
46             # This sub is called for every Harness event. We capture the data we need so we can emit the appropriate junit file.
47              
48             sub render_event {
49 0     0 1   my $self = shift;
50 0           my ($event) = @_;
51              
52             # We modify the event, which would be bad if there were multiple renderers,
53             # so we deep clone it.
54 0           $event = dclone($event);
55 0           my $f = $event->{facet_data};
56 0           my $job = $f->{harness_job};
57 0 0         my $job_id = $f->{'harness'}->{'job_id'} or return;
58 0   0       my $job_try = $f->{'harness'}->{'job_try'} // 0;
59 0           my $stamp = $event->{'stamp'};
60              
61 0 0         if ( !defined $stamp ) {
62 0   0       $f //= 'unknown facet_data';
63 0           die "No time stamp found for event '$f' ?!?!?!? ...\n" . "Event:\n" . Dumper($event) . "\n" . Carp::longmess();
64             }
65              
66             # Throw out job events if they are for a previous run and we've already started collecting job
67             # information for a successive run.
68 0 0 0       return if $self->{'tests'}->{$job_id} && $job_try < ( $self->{'tests'}->{$job_id}->{'job_try'} // 0 );
      0        
69              
70             # At job launch we need to start collecting a new junit testdata section.
71             # We throw out anything we've collected to date on a previous run.
72 0 0         if ( $f->{'harness_job_launch'} ) {
73 0           my $full_test_name = $job->{'file'};
74 0           my $test_file = File::Spec->abs2rel($full_test_name);
75              
76             $self->{'tests'}->{$job_id} = {
77             'name' => $job->{'file'},
78             'file' => _squeaky_clean($test_file),
79             'job_id' => $job_id,
80             'job_try' => $job_try,
81 0           'job_name' => $f->{'harness_job'}->{'job_name'},
82             'testcase' => [],
83             'system-out' => '',
84             'system-err' => '',
85             'start' => $stamp,
86             'last_job_start' => $stamp,
87             'testsuite' => {
88             'errors' => 0,
89             'failures' => 0,
90             'tests' => 0,
91             'name' => _get_testsuite_name($test_file),
92             'id' => $job_id, # add a UID in the XML output
93             },
94             };
95              
96 0           return;
97             }
98              
99 0           my $test = $self->{'tests'}->{$job_id};
100              
101             # We have all the data. Print the XML.
102 0 0         if ( $f->{'harness_job_end'} ) {
103 0           $self->close_open_failure_testcase( $test, -1 );
104 0           $test->{'stop'} = $event->{'stamp'};
105 0           $test->{'testsuite'}->{'time'} = $test->{'stop'} - $test->{'start'};
106 0           $test->{'testsuite'}->{'timestamp'} = _timestamp( $test->{'start'} );
107              
108 0 0         if ( $f->{'errors'} ) {
109 0           my $test_error_messages = '';
110 0           my $alternative_error = '';
111 0           foreach my $msg ( @{ $f->{'errors'} } ) {
  0            
112 0 0         next unless $msg->{'from_harness'};
113 0 0 0       next unless $msg->{'tag'} // '' eq 'REASON';
114              
115 0           my $details = $msg->{details};
116 0 0         if ( $details =~ m/^Planned for ([0-9]+) assertions?, but saw ([0-9]+)/ ) {
117 0           $test->{'testsuite'}->{'errors'} += abs( $1 - $2 );
118             }
119 0 0         if ( $details =~ m/Test script returned error|Assertion failures were encountered|Subtest failures were encountered/ ) {
120 0           $alternative_error .= "$details\n";
121             }
122             else {
123 0           $test_error_messages .= "$details\n";
124             }
125             }
126              
127 0 0 0       if ($test_error_messages) {
    0          
128 0           push @{ $test->{'testcase'} }, $self->xml->testcase(
129 0           { 'name' => "Test Plan Failure", 'time' => $stamp - $test->{'last_job_start'}, 'classname' => $test->{'testsuite'}->{'name'} },
130             $self->xml->failure($test_error_messages)
131             );
132             }
133              
134             # We only want to show this alternative error if all of the tests passed but the program still exited non-zero.
135             elsif (!$test->{'testsuite'}->{'errors'} && $alternative_error) {
136 0           $test->{'testsuite'}->{'errors'}++;
137 0           push @{ $test->{'testcase'} }, $self->xml->testcase(
138 0           { 'name' => "Program Ended Unexpectedly", 'time' => $stamp - $test->{'last_job_start'}, 'classname' => $test->{'testsuite'}->{'name'} },
139             $self->xml->failure($alternative_error)
140             );
141             }
142             }
143              
144 0           push @{ $test->{'testcase'} }, $self->xml->testcase(
145 0           { 'name' => "Tear down.", 'time' => $stamp - $test->{'last_job_start'}, 'classname' => $test->{'testsuite'}->{'name'} },
146             );
147              
148 0           return;
149             }
150              
151 0 0         if ( $f->{'plan'} ) {
152 0 0         if ( $f->{'plan'}->{'skip'} ) {
153 0           my $skip = $f->{'plan'}->{'details'};
154 0           $test->{'system-out'} .= "# SKIP $skip\n";
155             }
156 0 0         if ( $f->{'plan'}->{'count'} ) {
157 0           $test->{'plan'} = $f->{'plan'}->{'count'};
158             }
159              
160 0           return;
161             }
162              
163 0 0         if ( $f->{'harness_job_exit'} ) {
164 0 0         return unless $f->{'harness_job_exit'}->{'exit'};
165              
166             # If we don't see
167 0           $test->{'testsuite'}->{'errors'}++;
168 0   0       $test->{'error-msg'} //= $f->{'harness_job_exit'}->{'details'} . "\n";
169              
170 0           return;
171             }
172              
173             # We just hit an ok/not ok line.
174 0 0         if ( $f->{'assert'} ) {
175              
176             # Ignore subtests
177 0 0 0       return if ( $f->{'hubs'} && $f->{'hubs'}->[0]->{'nested'} );
178              
179 0   0       my $test_num = sprintf( "%04d", $event->{'assert_count'} || $f->{'assert'}->{'number'} || die Dumper $event);
180 0   0       my $test_name = _squeaky_clean( $f->{'assert'}->{'details'} // 'UNKNOWN_TEST?' );
181 0 0         my $test_string = defined $test_name ? "$test_num - $test_name" : $test_num;
182 0           $test->{'testsuite'}->{'tests'}++;
183              
184 0           $self->close_open_failure_testcase( $test, $test_num );
185              
186 0 0         warn Dumper $event unless $stamp;
187              
188 0           my $run_time = $stamp - $test->{'last_job_start'};
189 0           $test->{'last_job_start'} = $stamp;
190              
191 0 0 0       if ( $f->{'amnesty'} && grep { ( $_->{'tag'} // '' ) eq 'TODO' } @{ $f->{'amnesty'} } ) { # All TODO Tests
  0 0 0        
  0            
192 0 0         if ( !$f->{'assert'}->{'pass'} ) { # Failing TODO
    0          
193 0           push @{ $test->{'testcase'} }, $self->xml->testcase( { 'name' => "$test_string (TODO)", 'time' => $run_time, 'classname' => $test->{'testsuite'}->{'name'} }, "" );
  0            
194             }
195             elsif ( $self->{'allow_passing_todos'} ) { # junit parsers don't like passing TODO tests. Let's just not tell them about it if $ENV{ALLOW_PASSING_TODOS} is set.
196 0           push @{ $test->{'testcase'} }, $self->xml->testcase( { 'name' => "$test_string (PASSING TODO)", 'time' => $run_time, 'classname' => $test->{'testsuite'}->{'name'} }, "" );
  0            
197             }
198             else { # Passing TODO (Failure) when not allowed.
199              
200 0           $test->{'testsuite'}->{'failures'}++;
201 0           $test->{'testsuite'}->{'errors'}++;
202              
203             # Grab the first amnesty description that's a TODO message.
204 0   0       my ($todo_message) = map { $_->{'details'} } grep { $_->{'tag'} // '' eq 'TODO' } @{ $f->{'amnesty'} };
  0            
  0            
  0            
205              
206 0           push @{ $test->{'testcase'} }, $self->xml->testcase(
207 0           { 'name' => "$test_string (TODO)", 'time' => $run_time, 'classname' => $test->{'testsuite'}->{'name'} },
208             $self->xml->error(
209             { 'message' => $todo_message, 'type' => "TodoTestSucceeded" },
210             $self->_cdata("ok $test_string")
211             )
212             );
213              
214             }
215             }
216             elsif ( $f->{'assert'}->{'pass'} ) { # Passing test
217 0           push @{ $test->{'testcase'} }, $self->xml->testcase(
218 0           { 'name' => "$test_string", 'time' => $run_time, 'classname' => $test->{'testsuite'}->{'name'} },
219             ""
220             );
221             }
222             else { # Failing Test.
223 0           $test->{'testsuite'}->{'failures'}++;
224 0           $test->{'testsuite'}->{'errors'}++;
225              
226             # Trap the test information. We can't generate the XML for this test until we get all the diag information.
227 0           $test->{'last_failure'} = {
228             'test_num' => $test_num,
229             'test_name' => $test_name,
230             'time' => $run_time,
231             'message' => "not ok $test_string\n",
232             };
233             }
234              
235 0           return;
236             }
237              
238 0 0 0       if ( $f->{'info'} && $test->{'last_failure'} ) {
239 0           foreach my $line ( @{ $f->{'info'} } ) {
  0            
240 0 0         next unless $line->{'details'};
241 0           chomp $line->{'details'};
242 0           $test->{'last_failure'}->{'message'} .= "# $line->{details}\n";
243             }
244 0           return;
245             }
246              
247             }
248              
249             # This is called when the last run is complete and we're ready to emit the junit file.
250              
251             sub finish {
252 0     0 1   my $self = shift;
253              
254 0 0         open( my $fh, '>:encoding(UTF-8)', $self->{'junit_file'} ) or die("Can't open '$self->{junit_file}' ($!)");
255              
256 0           my $xml = $self->xml;
257              
258             # These are method calls but you can't do methods with a dash in them so we have to store them as a SV and call it.
259 0           my $out_method = 'system-out';
260 0           my $err_method = 'system-err';
261              
262 0           print {$fh} "\n";
  0            
263 0           my @jobs = sort { $a->{'job_name'} <=> $b->{'job_name'} } values %{ $self->{'tests'} };
  0            
  0            
264 0           foreach my $job (@jobs) {
265 0           print {$fh} $xml->testsuite(
266             $job->{'testsuite'},
267 0           @{ $job->{'testcase'} },
268             $xml->$out_method( $self->_cdata( $job->{$out_method} ) ),
269 0           $xml->$err_method( $self->_cdata( $job->{$err_method} ) ),
270             ) . "\n";
271             }
272              
273 0           print {$fh} "\n";
  0            
274 0           close $fh;
275              
276 0           return;
277             }
278              
279             # Because we want to test diag messages after a failed test, we delay closing failures
280             # until we see the end of the testcase or until we see a new test number.
281              
282             sub close_open_failure_testcase {
283 0     0 1   my ( $self, $test, $new_test_number ) = @_;
284              
285             # Need to handle failed TODOs
286              
287             # The last test wasn't a fail.
288 0 0         return unless $test->{'last_failure'};
289              
290 0           my $fail = $test->{'last_failure'};
291 0 0         if ( $fail->{'test_num'} == $new_test_number ) {
292 0           die("The same assert number ($new_test_number) was seen twice for $test->{name}");
293             }
294              
295 0           my $xml = $self->xml;
296 0           push @{ $test->{'testcase'} }, $xml->testcase(
297             { 'name' => "$fail->{test_num} - $fail->{test_name}", 'time' => $fail->{'time'}, 'classname' => $test->{'testsuite'}->{'name'} },
298             $xml->failure(
299             { 'message' => "not ok $fail->{test_num} - $fail->{test_name}", 'type' => 'TestFailed' },
300 0           $self->_cdata( $fail->{'message'} )
301             )
302             );
303              
304 0           delete $test->{'last_failure'};
305 0           return;
306             }
307              
308             sub xml {
309 0     0 1   my $self = shift;
310 0           return $self->{'xml'};
311             }
312              
313             # These helpers were borrowed from https://metacpan.org/pod/TAP::Formatter::JUnit. Thanks!
314              
315             ###############################################################################
316             # Generates the name for the entire test suite.
317             sub _get_testsuite_name {
318 0     0     my $name = shift;
319 0           $name =~ s{^\./}{};
320 0           $name =~ s{^t/}{};
321 0           return _clean_to_java_class_name($name);
322             }
323              
324             ###############################################################################
325             # Cleans up the given string, removing any characters that aren't suitable for
326             # use in a Java class name.
327             sub _clean_to_java_class_name {
328 0     0     my $str = shift;
329 0           $str =~ s/[^-:_A-Za-z0-9]+/_/gs;
330 0           return $str;
331             }
332              
333             ###############################################################################
334             # Creates a CDATA block for the given data (which is made squeaky clean first,
335             # so that JUnit parsers like Hudson's don't choke).
336             sub _cdata {
337 0     0     my ( $self, $data ) = @_;
338              
339             # When I first added this conditional, I returned $data and at one point it was returning ^A and breaking the xml parser.
340 0 0 0       return '' if ( !$data or $data !~ m/\S/ms );
341              
342 0           return $self->xml->xmlcdata( _squeaky_clean($data) );
343             }
344              
345             ###############################################################################
346             # Clean a string to the point that JUnit can't possibly have a problem with it.
347             sub _squeaky_clean {
348 0     0     my $string = shift;
349              
350             # control characters (except CR and LF)
351 0           $string =~ s/([\x00-\x09\x0b\x0c\x0e-\x1f])/"^".chr(ord($1)+64)/ge;
  0            
352              
353             # high-byte characters
354 0           $string =~ s/([\x7f-\xff])/'[\\x'.sprintf('%02x',ord($1)).']'/ge;
  0            
355 0           return $string;
356             }
357              
358             sub _timestamp {
359 0     0     my $time = shift;
360 0           return POSIX::strftime( '%Y-%m-%dT%H:%M:%S', localtime( int($time) ) );
361             }
362              
363             1;
364              
365             __END__