#!/usr/bin/perl
package output::html;
use Exporter;
@ISA = qw(Exporter);
use strict;
use warnings;
use FindBin qw($RealBin);
use lib "$RealBin/..";
use Subunit qw(parse_results);
sub new($$$) {
my ($class, $dirname, $statistics) = @_;
my $self = {
dirname => $dirname,
active_test => undef,
local_statistics => {},
statistics => $statistics,
msg => "",
error_summary => {
skip => [],
expected_success => [],
unexpected_success => [],
expected_failure => [],
unexpected_failure => [],
skip_testsuites => [],
error => []
}
};
link("$RealBin/output/testresults.css", "$dirname/testresults.css");
open(INDEX, ">$dirname/index.html");
bless($self, $class);
$self->print_html_header("Samba Testsuite Run", *INDEX);
print INDEX "
";
print INDEX " \n";
print INDEX " \n";
print INDEX " Test \n";
print INDEX " Result \n";
print INDEX " \n";
return $self;
}
sub print_html_header($$$)
{
my ($self, $title, $fh) = @_;
print $fh "\n";
print $fh "\n";
print $fh " $title \n";
print $fh " \n";
print $fh "\n";
print $fh "\n";
print $fh "\n";
print $fh " $title \n";
print $fh " \n";
}
sub print_html_footer($$)
{
my ($self, $fh) = @_;
print $fh " \n";
print $fh "
\n";
print $fh "\n";
print $fh "\n";
}
sub output_msg($$);
sub start_testsuite($$)
{
my ($self, $name) = @_;
$self->{local_statistics} = {
success => 0,
skip => 0,
error => 0,
failure => 0
};
$self->{NAME} = $name;
$self->{HTMLFILE} = "$name.html";
$self->{HTMLFILE} =~ s/[:\t\n \/]/_/g;
open(TEST, ">$self->{dirname}/$self->{HTMLFILE}") or die("Unable to open $self->{HTMLFILE} for writing");
$self->print_html_header("Test Results for $name", *TEST);
print TEST "Tests \n";
print TEST " \n";
}
sub control_msg($$)
{
my ($self, $output) = @_;
$self->{msg} .= "$output \n";
}
sub output_msg($$)
{
my ($self, $output) = @_;
unless (defined($self->{active_test})) {
print TEST "$output ";
} else {
$self->{msg} .= "$output ";
}
}
sub end_testsuite($$$$)
{
my ($self, $name, $result, $unexpected, $reason) = @_;
print TEST "
\n";
print TEST "Duration: " . (time() - $self->{START_TIME}) . "s
\n";
$self->print_html_footer(*TEST);
close(TEST);
print INDEX "\n";
print INDEX " {HTMLFILE}\">$name \n";
my $st = $self->{local_statistics};
if (not $unexpected) {
if ($result eq "failure") {
print INDEX " ";
} else {
print INDEX " ";
}
} else {
print INDEX " ";
}
my $l = 0;
if ($st->{success} > 0) {
print INDEX "$st->{success} ok";
$l++;
}
if ($st->{skip} > 0) {
print INDEX ", " if ($l);
print INDEX "$st->{skip} skipped";
$l++;
}
if ($st->{failure} > 0) {
print INDEX ", " if ($l);
print INDEX "$st->{failure} failures";
$l++;
}
if ($st->{error} > 0) {
print INDEX ", " if ($l);
print INDEX "$st->{error} errors";
$l++;
}
if ($l == 0) {
if (not $unexpected) {
print INDEX "OK";
} else {
print INDEX "FAIL";
}
}
print INDEX " ";
print INDEX " \n";
}
sub start_test($$)
{
my ($self, $parents, $testname) = @_;
if ($#$parents == -1) {
$self->{START_TIME} = time();
$self->start_testsuite($testname);
return;
}
$self->{active_test} = $testname;
$self->{msg} = "";
}
sub end_test($$$$$$)
{
my ($self, $parents, $testname, $result, $unexpected, $reason) = @_;
if ($#$parents == -1) {
$self->end_testsuite($testname, $result, $unexpected, $reason);
return;
}
print TEST "";
$self->{local_statistics}->{$result}++;
my $track_class;
if ($result eq "skip") {
print TEST "\n";
$track_class = "skip";
} elsif ($unexpected) {
print TEST " \n";
if ($result eq "error") {
$track_class = "error";
} else {
$track_class = "unexpected_$result";
}
} else {
if ($result eq "failure") {
print TEST " \n";
} else {
print TEST " \n";
}
$track_class = "expected_$result";
}
push(@{$self->{error_summary}->{$track_class}}, ,
[$self->{HTMLFILE}, $testname, $self->{NAME},
$reason]);
print TEST "$testname \n";
print TEST $self->{msg};
if (defined($reason)) {
print TEST "$reason
\n";
}
print TEST " \n";
$self->{active_test} = undef;
}
sub summary($)
{
my ($self) = @_;
my $st = $self->{statistics};
print INDEX "\n";
print INDEX " Total \n";
if ($st->{TESTS_UNEXPECTED_OK} == 0 and
$st->{TESTS_UNEXPECTED_FAIL} == 0 and
$st->{TESTS_ERROR} == 0) {
print INDEX " ";
} else {
print INDEX " ";
}
print INDEX ($st->{TESTS_EXPECTED_OK} + $st->{TESTS_UNEXPECTED_OK}) . " ok";
if ($st->{TESTS_UNEXPECTED_OK} > 0) {
print INDEX " ($st->{TESTS_UNEXPECTED_OK} unexpected)";
}
if ($st->{TESTS_SKIP} > 0) {
print INDEX ", $st->{TESTS_SKIP} skipped";
}
if (($st->{TESTS_UNEXPECTED_FAIL} + $st->{TESTS_EXPECTED_FAIL}) > 0) {
print INDEX ", " . ($st->{TESTS_UNEXPECTED_FAIL} + $st->{TESTS_EXPECTED_FAIL}) . " failures";
if ($st->{TESTS_UNEXPECTED_FAIL} > 0) {
print INDEX " ($st->{TESTS_EXPECTED_FAIL} expected)";
}
}
if ($st->{TESTS_ERROR} > 0) {
print INDEX ", $st->{TESTS_ERROR} errors";
}
print INDEX " ";
print INDEX " \n";
print INDEX "
\n";
print INDEX "Summary \n";
print INDEX " \n";
$self->print_html_footer(*INDEX);
close(INDEX);
my $summ = $self->{error_summary};
open(SUMMARY, ">$self->{dirname}/summary.html");
$self->print_html_header("Summary", *SUMMARY);
sub print_table($$) {
my ($title, $list) = @_;
return if ($#$list == -1);
print SUMMARY "$title \n";
print SUMMARY "\n";
print SUMMARY "\n";
print SUMMARY " Testsuite \n";
print SUMMARY " Test \n";
print SUMMARY " Reason \n";
print SUMMARY " \n";
foreach (@$list) {
print SUMMARY "\n";
print SUMMARY " $$_[2] \n";
print SUMMARY " $$_[1] \n";
if (defined($$_[3])) {
print SUMMARY " $$_[3] \n";
} else {
print SUMMARY " \n";
}
print SUMMARY " \n";
}
print SUMMARY "
";
}
print_table("Errors", $summ->{error});
print_table("Unexpected successes", $summ->{unexpected_success});
print_table("Unexpected failures", $summ->{unexpected_failure});
print_table("Skipped tests", $summ->{skip});
print_table("Expected failures", $summ->{expected_failure});
print SUMMARY "Skipped testsuites \n";
print SUMMARY "\n";
print SUMMARY "\n";
print SUMMARY " Testsuite \n";
print SUMMARY " Reason \n";
print SUMMARY " \n";
foreach (@{$summ->{skip_testsuites}}) {
print SUMMARY "\n";
print SUMMARY " $$_[0] \n";
if (defined($$_[1])) {
print SUMMARY " $$_[1] \n";
} else {
print SUMMARY " \n";
}
print SUMMARY " \n";
}
print SUMMARY "
";
$self->print_html_footer(*SUMMARY);
close(SUMMARY);
}
sub skip_testsuite($$$$)
{
my ($self, $name, $reason) = @_;
push (@{$self->{error_summary}->{skip_testsuites}},
[$name, $reason]);
}
1;