cunit-to-junit.pl
No OneTemporary
Actions

Authored By

Unknown

Size

4 KB

Referenced Files

None

Subscribers

None

cunit-to-junit.pl
View Options

	#!/usr/bin/perl

	use strict;
	use warnings;
	use XML::DOM;
	use File::Path qw(mkpath rmtree);
	use File::Basename qw(dirname);
	use Data::Dumper;
	use Carp;

	my $verbose = 0;
	my $infile = 'CUnitAutomated-Results.xml';
	my $outbase = 'reports/TEST-';

	sub get_child
	{
	my ($node, $name) = @_;

	croak "Invalid document"
	unless defined $node;
	my $kids = $node->getElementsByTagName($name, 0);
	croak "Invalid document: name=$name"
	unless (defined $kids && $kids->getLength == 1);
	return $kids->item(0);
	}

	sub get_child_maybe
	{
	my ($node, $name) = @_;

	croak "Invalid document"
	unless defined $node;
	my $kids = $node->getElementsByTagName($name, 0);
	return undef
	if !defined $kids;
	return undef
	if $kids->getLength == 0;
	croak "Invalid document"
	if $kids->getLength > 1;
	return $kids->item(0);
	}

	sub get_children
	{
	my ($node, $name) = @_;

	croak "Invalid document"
	unless defined $node;
	return ( $node->getElementsByTagName($name, 0) );
	}

	sub get_content
	{
	my ($node, $name) = @_;

	croak "Invalid document"
	unless defined $node;
	my $s = $node->getFirstChild->getData;
	if (defined $s)
	{
	$s =~ s/^\s+//;
	$s =~ s/\s+$//;
	}
	return $s;
	}

	my @suites;
	sub get_suite
	{
	my ($sname) = @_;

	printf STDERR "Suite \"%s\"\n", $sname if $verbose;

	my @existing = grep { $_->{name} eq $sname; } @suites;
	return $existing[0] if scalar @existing;

	my $s = {
	name => $sname,
	nerrors => 0,
	tests => [],
	tests_by_name => {},
	};
	push(@suites, $s);
	return $s;
	}

	sub _add_test
	{
	my ($s, $tname) = @_;

	my $t = $s->{tests_by_name}->{$tname};
	if (!defined $t)
	{
	$t = {
	name => $tname,
	errors => [],
	};
	push(@{$s->{tests}}, $t);
	$s->{tests_by_name}->{$tname} = $t;
	}
	return $t;
	}

	sub add_pass
	{
	my ($s, $tname) = @_;
	printf STDERR " Test \"%s\": pass\n", $tname if $verbose;
	_add_test($s, $tname);
	}

	sub add_fail
	{
	my ($s, $tname, $msg) = @_;
	printf STDERR " Test \"%s\": fail\n %s\n", $tname, $msg
	if $verbose;
	my $t = _add_test($s, $tname);
	push(@{$t->{errors}}, $msg);
	$s->{nerrors}++;
	}

	my $parser = new XML::DOM::Parser;
	my $doc = $parser->parsefile($infile);

	my $root = get_child($doc, 'CUNIT_TEST_RUN_REPORT');
	my $result = get_child($root, 'CUNIT_RESULT_LISTING');

	foreach my $suite (get_children($result, 'CUNIT_RUN_SUITE'))
	{
	my $succ = get_child_maybe($suite, 'CUNIT_RUN_SUITE_SUCCESS');
	my $fail = get_child_maybe($suite, 'CUNIT_RUN_SUITE_FAILURE');

	if (defined $succ)
	{
	my $s = get_suite(get_content(get_child($succ, 'SUITE_NAME')));

	foreach my $record (get_children($succ, 'CUNIT_RUN_TEST_RECORD'))
	{
	my $tr;

	$tr = get_child_maybe($record, 'CUNIT_RUN_TEST_SUCCESS');
	if (defined $tr)
	{
	my $tname = get_content(get_child($tr, 'TEST_NAME'));
	add_pass($s, $tname);
	next;
	}

	foreach $tr (get_children($record, 'CUNIT_RUN_TEST_FAILURE'))
	{
	my $tname = get_content(get_child($tr, 'TEST_NAME'));
	my $fname = get_content(get_child($tr, 'FILE_NAME'));
	my $lineno = get_content(get_child($tr, 'LINE_NUMBER'));
	my $cond = get_content(get_child($tr, 'CONDITION'));
	add_fail($s, $tname, "$fname:$lineno: $cond");
	next;
	}
	}
	}
	elsif (defined $fail)
	{
	# TODO: there must be a way in the jUnit output format
	# to report a failure of the suite fixture code, but
	# I have no idea what it is. Instead use a fake test name.
	my $s = get_suite(get_content(get_child($fail, 'SUITE_NAME')));
	my $reason = get_content(get_child($fail, 'FAILURE_REASON'));

	my $tname = '__wtf';
	if ($reason =~ m/cleanup/i)
	{
	$tname = '__cleanup';
	}
	elsif ($reason =~ m/initialization/i)
	{
	$tname = '__cleanup';
	}

	add_fail($s, $tname, $reason);
	}
	else
	{
	carp "Neither a CUNIT_RUN_SUITE_SUCCESS nor a " .
	"CUNIT_RUN_SUITE_FAILURE child are present";
	}

	}

	my $dir = dirname($outbase . 'foo');
	rmtree($dir) if (defined $dir && $dir ne '.');
	my $nrun = 0;
	my $nfailed = 0;

	foreach my $s (@suites)
	{
	my $sdoc = XML::DOM::Document->new();

	$nfailed += $s->{nerrors};

	my $selt = $sdoc->createElement('testsuite');
	$selt->setAttribute(failures => 0);
	$selt->setAttribute(errors => $s->{nerrors});
	$selt->setAttribute(time => "0.001");
	$selt->setAttribute(tests => scalar @{$s->{tests}});
	$selt->setAttribute(name => $s->{name});
	$sdoc->appendChild($selt);

	foreach my $t (@{$s->{tests}})
	{
	$nrun++;

	my $telt = $sdoc->createElement('testcase');
	$telt->setAttribute(time => "0.001");
	$telt->setAttribute(name => $t->{name});
	$selt->appendChild($telt);

	foreach my $e (@{$t->{errors}})
	{
	my $eelt = $sdoc->createElement('error');
	$eelt->appendChild($sdoc->createTextNode($e));
	$telt->appendChild($eelt);
	}
	}

	my $fname = $outbase . $s->{name} . '.xml';
	mkpath(dirname($fname));
	$sdoc->printToFile($fname);
	}

	print "$0: ran $nrun tests, $nfailed failed\n";
	exit(1) if ($nfailed > 0);

File Metadata

Mime Type: text/x-perl
Expires: Fri, Apr 24, 10:00 AM (6 d, 4 h ago)
Storage Engine: blob
Storage Format: Raw Data
Storage Handle: 18855311
Default Alt Text: cunit-to-junit.pl (4 KB)

cunit-to-junit.plNo OneTemporaryActions

cunit-to-junit.plView Options

File Metadata

Event Timeline

cunit-to-junit.pl
No OneTemporary
Actions

cunit-to-junit.pl
View Options