#!/usr/bin/perl
# HTML output for selftest
# Copyright (C) 2008 Jelmer Vernooij
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
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 "
\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 "