cgal/Packages/Maintenance/test_handling/create_testresult_page

611 lines
15 KiB
Perl
Executable File

#!/sw/bin/perl -w
#
# version: 3.0
# author: Geert-Jan Giezeman
#
# This script creates a WWW page with a table of test suite results.
#
# Usage:
# create_testpage [-p previous-release] <directory>
use strict;
use vars qw($opt_p);
use Getopt::Std;
my ($PLATFORMS_BESIDE_RESULTS, $PLATFORMS_REF_BETWEEN_RESULTS)=(1,1);
my $SCRIPTDIR = '/projects/CGAL/admin_scripts';
my $TEMPPAGE="tmp$$.html";
my $WWWPAGE;
my $release_name;
my @platforms_to_do;
my @known_platforms;
my %platform_short_names;
my @available_platforms;
my @test_directories;
my @testresults;
sub list_platforms()
{
my ($filename, @result);
foreach $_ (glob("results_*.txt")) {
($filename) = m/results_(.*?)\.txt\s*/;
push(@result, $filename) if $filename;
}
return @result;
}
sub list_packages($)
#
# Fill @test_directories with the packages found in the argument platform.
# Return false if that platform does not have a list of packages.
{
my ($platform) = @_;
@test_directories = ();
my $test_result="results_${platform}.txt";
open(TESTRESULT, $test_result) or return 0;
while (<TESTRESULT>) {
if (/^\s*(.*?)\s+(\w)\s*$/) {
push (@test_directories, $1);
}
}
close TESTRESULT or return 0;
return 1;
}
sub collect_results_of_platform($)
{
my ($platform) = @_;
# Create an anonymous hash that hashes packages to their result.
my $platform_results = {};
my $test_result="results_${platform}.txt";
my ($yeahs, $nays, $warnings) = (0,0,0);
my $resulttext;
open(TESTRESULT, $test_result) or return $platform_results;
while (<TESTRESULT>) {
if (/^\s*(.*?)\s+(\w)\s*$/) {
#($package,$succes) = ($1,$2);
if ($2 eq 'y' or $2 eq 'Y') {
$resulttext = 'y';
++$yeahs;
} elsif ($2 eq 'w' or $2 eq 'W') {
$resulttext = 'w';
++$warnings;
} elsif ($2 eq 'n' or $2 eq 'N') {
$resulttext = 'n';
++$nays;
} else {
$resulttext = ' ';
}
$platform_results->{$1} = $resulttext;
}
}
close TESTRESULT;
$platform_results->{"y"} = $yeahs;
$platform_results->{"n"} = $nays;
$platform_results->{"w"} = $warnings;
return $platform_results;
}
sub collect_results()
{
my $platform;
foreach $platform (@platforms_to_do) {
last if list_packages($platform);
}
foreach $platform (@platforms_to_do) {
push(@testresults, collect_results_of_platform($platform));
}
}
sub print_result_table()
{
my $platform_count = scalar(@platforms_to_do);
my $pc_plus_2 = $platform_count + 2;
print OUTPUT <<"EOF";
<TABLE CLASS="result" BORDER=1 CELLSPACING=2 CELLPADDING=5>
<TR>
<TD ALIGN=CENTER COLSPAN=$pc_plus_2>
<FONT SIZE="+2">Test Suite Results $release_name</FONT></TD>
</TR>
<TR ALIGN=CENTER>
<TH ROWSPAN=2>Package</TH>
<TH ROWSPAN=2>Version</TH>
<TH COLSPAN=$platform_count>Test Platform</TH>
</TR>
<TR ALIGN=CENTER>
EOF
my ($platform_num,$platform)=(0,"");
foreach $platform (@platforms_to_do) {
++$platform_num;
print OUTPUT "<TD><B>$platform_num</B></TD>\n";
}
print OUTPUT "</TR>\n";
my $test_directory;
my $test_num = 0;
foreach $test_directory (@test_directories) {
if ($PLATFORMS_REF_BETWEEN_RESULTS) {
$test_num++;
if ($test_num == 15) {
$test_num = 0;
print OUTPUT "\n<TR> <TD ALIGN=center COLSPAN=2 >\n";
print OUTPUT
'<A HREF="#platforms">Platform Description</A>';
print OUTPUT "\n</TD>\n";
$platform_num=0;
while ($platform_num < $platform_count) {
++$platform_num;
print OUTPUT "<TD ALIGN=center> <B> $platform_num</B></TD>\n";
}
print OUTPUT "\n</TR>\n";
}
}
my $version;
if ( -r "$test_directory/version" ) {
open(VERSION, "$test_directory/version");
while(<VERSION>) {
($version) = /^\s*([^\s]*)\s/;
last if $version;
}
close VERSION;
}
print OUTPUT "\n<TR>\n";
print OUTPUT "<TD>$test_directory</TD>\n";
if ( $version ) {
print OUTPUT "<TD ALIGN=CENTER>$version</TD>\n";
} else {
print OUTPUT "<TD ALIGN=CENTER>?.?</TD>\n";
}
$platform_num=0;
foreach $platform (@platforms_to_do) {
my ($result,$resulttext);
$resulttext = $testresults[$platform_num]->{$test_directory};
if (! defined($resulttext)) {
$resulttext = ' ';
}
print OUTPUT '<TD ALIGN=CENTER';
if ($resulttext eq 'y') {
print OUTPUT ' class=ok';
} elsif ($resulttext eq 'w') {
print OUTPUT ' class=warning';
} elsif ($resulttext eq 'n') {
print OUTPUT ' class=error';
}
print OUTPUT '> <A HREF="',
"$release_name/$test_directory/TestReport_$platform.gz\"";
print OUTPUT '>', "$resulttext</A></TD>\n";
++$platform_num;
}
print OUTPUT "</TR>\n";
}
print OUTPUT "</TABLE>\n";
}
sub print_resultpage()
{
my $platform_count = scalar(@platforms_to_do);
my $pc_plus_2 = $platform_count + 2;
print OUTPUT '<H2><A NAME="testresults">Test Results</A></H2>',"\n";
if ($PLATFORMS_BESIDE_RESULTS) {
print OUTPUT <<"EOF";
<TABLE BORDER=0 CELLSPACING=5 CELLPADDING=0>
<TR ALIGN=CENTER>
<TD>
EOF
}
print_result_table();
if ($PLATFORMS_BESIDE_RESULTS) {
print OUTPUT <<"EOF";
</TD>
<TD>
<TABLE BORDER=0 CELLSPACING=2 CELLPADDING=0>
EOF
if ($platform_count > 0) {
my $repeat_count = (1 + 1.1/16.5)*scalar(@test_directories)/($platform_count+0.25);
while ($repeat_count >= 1) {
$repeat_count--;
print OUTPUT <<"EOF";
<TR>
<TD>
EOF
print_platforms();
print OUTPUT <<"EOF";
</TD>
</TR>
EOF
}
}
print OUTPUT <<"EOF";
</TABLE>
</TD>
</TR>
</TABLE>
EOF
}
}
sub parse_platform($)
{
my ($pf) = @_;
$pf =~ s/_LEDA$//;
my @list = split /_/, $pf;
return @list;
}
sub parse_platform_2($)
{
my ($pf) = @_;
my @list = parse_platform($pf);
if (@list > 3) {
splice(@list,0,@list-3);
}
while (@list < 3) {
push(@list,'?');
}
return @list;
}
sub short_pfname($)
{
my @pflist = parse_platform_2($_[0]);
my $shortpf = join('_', $pflist[2], $pflist[1]);
return $shortpf;
}
sub choose_platforms()
{
my (%platform_index, $pf);
# List all platforms for which there are results
@available_platforms = list_platforms();
my $index = 0;
# Put all known platforms in a hash table.
for ($index=0; $index < @known_platforms; $index += 1) {
$pf = $known_platforms[$index];
$platform_index{$pf} = 1;
}
# Check if there are platforms listed that are not known. Warn about this
# and add those platforms at the end of the list of known platforms.
foreach (@available_platforms) {
$pf = $_;
my @pflist = parse_platform_2($pf);
my $shortpf = join('_', $pflist[2], $pflist[1]);
$pf =~ s/^[^_]*_//;
$pf =~ s/_LEDA$//;
if (!exists $platform_index{$shortpf}) {
print STDERR
"Warning: Platform $_ is unknown!\n";
$platform_index{$shortpf} = 1;
push(@known_platforms,$shortpf); # ???
$platform_short_names{$shortpf} = $shortpf;
}
}
# Make a list of all the platforms that are to be treated, in the order they
# appear in the list of known_platforms.
@platforms_to_do = ();
@known_platforms = sort(@known_platforms);
for ($index=0; $index < @known_platforms; $index += 1) {
$pf = $known_platforms[$index];
my $ind2 = 0;
foreach (@available_platforms) {
my $apf = short_pfname($_);
if ($apf eq $pf) {
push(@platforms_to_do, $_);
}
}
}
}
sub print_platform_descriptions()
{
my ($i,$pf_no,$pf) = (0,1);
print OUTPUT <<'EOF';
<TABLE BORDER=1 CELLSPACING=2 CELLPADDING=5 >
<TR ALIGN=CENTER>
<TH COLSPAN=2>OS and compiler</TH>
<TH>tester</TH>
<TH>LEDA</TH>
<TH>GMP</TH>
<TH>CLN</TH>
<TH>QT</TH>
<TH class=ok>y</TH>
<TH class=warning>w</TH>
<TH class=error>n</TH>
</TR>
EOF
my ($platform_num)=(0);
foreach $pf (@platforms_to_do) {
print OUTPUT "<TR>\n<TD>$pf_no</TD>\n";
$pf_no++;
my $pf_short = join('_',parse_platform_2($pf));
print OUTPUT "<TD NOWRAP>$pf_short</TD>\n";
if (open (PLATFORM_INFO, "results_${pf}.info")) {
$_ = <PLATFORM_INFO>;
$_ = <PLATFORM_INFO>;
chomp;
$_ = email_address_in_html_format($_);
print OUTPUT "<TD NOWRAP>$_</TD>\n";
my $index = 4;
while ($index) {
$index--;
$_ = <PLATFORM_INFO>;
chomp;
print OUTPUT "<TD ALIGN=CENTER NOWRAP>$_</TD>\n";
}
} else {
print OUTPUT "<TD NOWRAP>?</TD>\n";
print OUTPUT "<TD NOWRAP>?</TD>\n";
print OUTPUT "<TD NOWRAP>?</TD>\n";
print OUTPUT "<TD NOWRAP>?</TD>\n";
}
my $count;
$count = $testresults[$platform_num]->{"y"};
print OUTPUT "<TD>$count</TD>\n";
$count = $testresults[$platform_num]->{"w"};
print OUTPUT "<TD>$count</TD>\n";
$count = $testresults[$platform_num]->{"n"};
print OUTPUT "<TD>$count</TD>\n";
++$platform_num;
}
print OUTPUT "</TABLE>\n";
}
sub print_platforms()
{
my ($pf_no,$pf) = (1,"");
print OUTPUT <<'EOF';
<TABLE BORDER=1 CELLSPACING=2 CELLPADDING=5 >
EOF
foreach $pf (@platforms_to_do) {
print OUTPUT "<TR>\n<TD>$pf_no</TD>\n";
$pf_no++;
my $pf_short = short_pfname($pf);
print OUTPUT "<TD NOWRAP>$platform_short_names{$pf_short}</TD>\n";
print OUTPUT "</TR>\n";
}
print OUTPUT "</TABLE>\n";
}
sub search_previous_release()
{
if (! -r $WWWPAGE) {
print STDERR "Warning: no previous release known.\n";
print STDERR "Did you forget the -p option?.\n";
return;
}
open INPUT, $WWWPAGE or die;
while (<INPUT>) {
if (m/<!-- previous version: (.*) -->/) {
$opt_p = $1;
last;
}
}
close INPUT;
}
sub result_filename($)
{
return "results".substr($_[0],4).".html";
# $name =~ s/-I-/-/;
}
sub print_header() {
my ($date,$month,@time_date_info);
@time_date_info = localtime;
$month = ('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec')[$time_date_info[4] ];
$date = "$time_date_info[3] $month ". (1900+$time_date_info[5]);
print OUTPUT<<"EOF";
<HTML>
<HEAD><TITLE>CGAL Test Result Page</TITLE>
<LINK REL=stylesheet HREF="testresult.sty">
<!-- This file is generated by a program. Don't edit manually!! -->
</HEAD>
<BODY>
<P><IMG SRC="http://www.cs.uu.nl/CGAL/images/c-simp.gif"
ALT="Logo C" HEIGHT=108 WIDTH=108 ALIGN=CENTER>
<IMG SRC="http://www.cs.uu.nl/CGAL/images/g-simp.gif"
ALT="Logo G" HEIGHT=108 WIDTH=108 ALIGN=CENTER>
<IMG SRC="http://www.cs.uu.nl/CGAL/images/a-simp.gif"
ALT="Logo A" HEIGHT=117 WIDTH=115 ALIGN=CENTER>
<IMG SRC="http://www.cs.uu.nl/CGAL/images/l-simp.gif"
ALT="Logo L" HEIGHT=116 WIDTH=106 ALIGN=CENTER>
<IMG SRC="http://www.cs.uu.nl/CGAL/images/cgal.gif"
ALT="[Computational GeometryAlgorithms Library]" HEIGHT=45 WIDTH=419 ALIGN=CENTER>
<BR>
Last modified: $date
<HR></P>
EOF
# print OUTPUT `$SCRIPTDIR/print_cgal_header "CGAL Test Result Page"`;
if (defined($opt_p)) {
print OUTPUT "<!-- previous version: $opt_p -->\n";
}
print OUTPUT<<"EOF";
<H1>CGAL Test Result Page</H1>
This page contains the results from test suite $release_name of supported compilers.
<P>The results of the tests are presented in a table
('y' = success, 'w' = warning, 'n' = failure),
and the error + compiler output from each test can be retrieved by clicking
on it.
<BR>
<B>N.B. The detection of warnings is not exact.
Look at the output to be sure!</B>
<OL>
<LI><A HREF="#platforms">Platform Description</A> </LI>
<LI><A HREF="#testresults">Test Results</A> </LI>
<LI><A HREF="http://www.cgal.org/Members/Manual_test/${release_name}.manual_test.html">
The documentation of this release</A></LI>
EOF
#<LI><A HREF="http://www.mpi-sb.mpg.de/~hert/CGAL/${release_name}.manual_test.html">
if (defined($opt_p)) {
my $prev_page = result_filename($opt_p);
print OUTPUT<<"EOF";
<LI><A HREF="$prev_page">Test Results $opt_p</A></LI>
EOF
}
if ( -r "announce.html" ) {
print OUTPUT<<"EOF";
<LI><A HREF="$release_name/announce.html">Annoucement of this release</A></LI>
EOF
}
print OUTPUT<<'EOF';
</OL>
<HR>
<P>
EOF
}
sub main()
{
getopts('p:');
if (scalar(@ARGV) != 1 ) {
print STDERR "usage: $0 [-p previous-release-directory] directory\n";
exit 1;
}
$release_name =shift(@ARGV);
$release_name =~ s<(\s+)$><>;
$release_name =~ s<(/)$><>;
if ( ! -d $release_name ) {
print STDERR "$release_name is not a valid directory\n";
exit 1;
}
$WWWPAGE = result_filename($release_name);
if (defined($opt_p)) {
$opt_p =~ s</?\s*$><>;
} else {
search_previous_release();
}
undef($opt_p) if (defined ($opt_p) and $opt_p =~ /^\s*$/);
init_known_platforms();
chdir $release_name or die;
choose_platforms();
chdir "..";
umask 0002;
unlink $TEMPPAGE;
open(OUTPUT,">$TEMPPAGE") or die;
chdir $release_name or die;
collect_results();
print_header();
print OUTPUT
'<H2><A NAME="platforms">Platform Description and Summary</A></H2>',"\n";
print_platform_descriptions();
print OUTPUT "<P>\n";
print_resultpage();
print OUTPUT "<P>\n";
print OUTPUT `$SCRIPTDIR/print_cgal_trailer`;
close OUTPUT;
chdir "..";
rename $TEMPPAGE, $WWWPAGE;
chmod 0664, $WWWPAGE;
system("chgrp cgal $WWWPAGE");
system("cp $WWWPAGE results.html");
}
sub email_address_in_html_format($)
{
my $responsible = shift;
if (!defined($responsible)) {
print STDERR "Undefined responsible person.\n";
return "?";
}
my $qualification='';
if ($responsible =~ /(.*?)-(.*)$/ ) {
$responsible=$1;
$qualification = " ($2)";
}
if ($responsible eq 'baesken') {
return
'<A HREF="mailto:baesken@infsn2.informatik.uni-halle.de">'.
"Matthias Baesken</A>$qualification";
} elsif ($responsible eq 'spion') {
return '<A HREF="mailto:Sylvain.Pion@sophia.inria.fr">'.
"Sylvain Pion</A>$qualification";
} elsif ($responsible eq 'andreas') {
return '<A HREF="mailto:Andreas.Fabri@sophia.inria.fr">'.
"Andreas Fabri</A>$qualification";
} elsif ($responsible eq 'rursu') {
return '<A HREF="mailto:Radu.Ursu@sophia.inria.fr">'.
"Radu Ursu</A>$qualification";
} elsif ($responsible eq 'frebufat') {
return
'<A HREF="mailto:Francois.Rebufat@sophia.inria.fr">'.
"Fran&ccedil;ois Rebufat</A>$qualification";
} elsif ($responsible eq 'yvinec') {
return
'<A HREF="mailto:Mariette.Yvinec@sophia.inria.fr">'.
"Mariette Yvinec</A>$qualification";
} elsif ($responsible eq 'geert') {
return
'<A HREF="mailto:geert@cs.uu.nl">'.
"Geert-Jan Giezeman</A>$qualification";
} elsif ($responsible eq 'rineau') {
return
'<a href="mailto:rineau@clipper.ens.fr">'.
"Laurent Rineau</A>$qualification";
} elsif ($responsible eq 'dima') {
return
'<A HREF="mailto:dima@cs.uu.nl">'.
"Dima Pasechnik</A>$qualification";
} elsif ($responsible eq 'hoffmann') {
return
'<A HREF="mailto:hoffmann@inf.ethz.ch">'.
"Michael Hoffmann</A>$qualification";
} elsif ($responsible eq 'stschirr') {
return
'<A HREF="mailto:stschirr@mpi-sb.mpg.de">'.
"Stefan Schirra</A>$qualification";
} elsif ($responsible eq 'hert') {
return
'<A HREF="mailto:hert@mpi-sb.mpg.de">'.
"Susan Hert</A>$qualification";
} else {
print STDERR "Unknown responsible person $responsible.\n";
return "?";
}
}
sub init_known_platforms()
{
my ($short_name, $full_name);
open(PLATFORMS,'known_platforms') or die;
@known_platforms = ();
while(<PLATFORMS>) {
($short_name, $full_name) =split;
$full_name = short_pfname($full_name);
push(@known_platforms,$full_name);
$platform_short_names{$full_name} = $full_name;
}
close(PLATFORMS);
}
main();