#!/usr/local/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] use Cwd; use strict; use vars qw($opt_p); use Getopt::Std; my ($PLATFORMS_BESIDE_RESULTS, $PLATFORMS_REF_BETWEEN_RESULTS)=(1,1); my $SCRIPTDIR = './'; my $TEMPPAGE="tmp$$.html"; my $TEMPPAGE2="tmp2$$.html"; my $WWWPAGE; my $VERSIONS_WEBPAGE; my $release_name; my @platforms_to_do; my @known_platforms; my %platform_short_names; my @available_platforms; my @test_directories; my @testresults; my $currentdir; my $testresult_dir; $currentdir=cwd(); $testresult_dir="$currentdir/TESTRESULTS"; sub write_select() { my($filename, @result); print OUTPUTV << "EOF"; CGAL Versions EOF print OUTPUTV '

Test-suite results for CGAL version

"; print OUTPUTV ""; } 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 () { 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 () { 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"; EOF # # # my ($platform_num,$platform)=(0,""); foreach $platform (@platforms_to_do) { ++$platform_num; print OUTPUT "\n"; } print OUTPUT "\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\n"; $platform_num=0; while ($platform_num < $platform_count) { ++$platform_num; print OUTPUT "\n"; } print OUTPUT "\n\n"; } } # my $version; # if ( -r "$test_directory/version" ) { # open(VERSION, "$test_directory/version"); # while() { # ($version) = /^\s*([^\s]*)\s/; # last if $version; # } # close VERSION; # } print OUTPUT "\n\n"; print OUTPUT "\n"; # if ( $version ) { # print OUTPUT "\n"; # } else { # print OUTPUT "\n"; # } $platform_num=0; foreach $platform (@platforms_to_do) { my ($result,$resulttext); $resulttext = $testresults[$platform_num]->{$test_directory}; if (! defined($resulttext)) { $resulttext = ' '; } print OUTPUT '\n"; ++$platform_num; } print OUTPUT "\n"; } print OUTPUT "
Package Test Platform
#Test Suite Results $release_name
$platform_num
\n"; print OUTPUT "\n
\n"; print OUTPUT 'Platform Description'; print OUTPUT "\n $platform_num
$test_directory$version?.? ', "$resulttext
\n"; } sub print_resultpage() { my $platform_count = scalar(@platforms_to_do); my $pc_plus_2 = $platform_count + 2; print OUTPUT << "EOF";

Test Results for $release_name

EOF if ($PLATFORMS_BESIDE_RESULTS) { print OUTPUT <<"EOF";
EOF } print_result_table(); if ($PLATFORMS_BESIDE_RESULTS) { print OUTPUT <<"EOF"; 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"; EOF } } print OUTPUT <<"EOF";
EOF print_platforms(); print OUTPUT <<"EOF";
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'; EOF my ($platform_num)=(0); foreach $pf (@platforms_to_do) { print OUTPUT "\n\n"; $pf_no++; my $pf_short = join('_',parse_platform_2($pf)); print OUTPUT "\n"; if (open (PLATFORM_INFO, "results_${pf}.info")) { $_ = ; $_ = ; chomp; $_ = email_address_in_html_format($_); print OUTPUT "\n"; my $index = 4; while ($index) { $index--; $_ = ; chomp; print OUTPUT "\n"; } } else { print OUTPUT "\n"; print OUTPUT "\n"; print OUTPUT "\n"; print OUTPUT "\n"; } my $count; $count = $testresults[$platform_num]->{"y"}; print OUTPUT "\n"; $count = $testresults[$platform_num]->{"w"}; print OUTPUT "\n"; $count = $testresults[$platform_num]->{"n"}; print OUTPUT "\n"; ++$platform_num; } print OUTPUT "
OS and compiler tester LEDA GMP CLN QT y w n
$pf_no$pf_short$_$_????$count$count$count
\n"; } sub print_platforms() { my ($pf_no,$pf) = (1,""); print OUTPUT <<'EOF'; EOF foreach $pf (@platforms_to_do) { print OUTPUT "\n\n"; $pf_no++; my $pf_short = short_pfname($pf); print OUTPUT "\n"; print OUTPUT "\n"; } print OUTPUT "
$pf_no$platform_short_names{$pf_short}
\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 () { if (m//) { $opt_p = $1; last; } } close INPUT; } sub result_filename($) { return "results".substr($_[0],4).".html"; # $name =~ s/-I-/-/; } sub print_little_header(){ print OUTPUT<<"EOF"; CGAL Test Result Page 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.
N.B. The detection of warnings is not exact. Look at the output to be sure!
  1. Platform Description
  2. Test Results
  3. The documentation of this release
    4. EOF #

    CGAL Test Results for $release_name

    if (defined($opt_p)) { my $prev_page = result_filename($opt_p); print OUTPUT<<"EOF";
  4. Test Results $opt_p
    5. EOF } if ( -r "announce.html" ) { print OUTPUT<<"EOF";
  5. Announcement of this release
    6. EOF } print OUTPUT<<'EOF';
EOF } 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"; CGAL Test Result Page

Logo C Logo G Logo A Logo L [Computational GeometryAlgorithms Library]
Last modified: $date

EOF # print OUTPUT `$SCRIPTDIR/print_cgal_header "CGAL Test Result Page"`; if (defined($opt_p)) { print OUTPUT "\n"; } print OUTPUT<<"EOF";

CGAL Test Result Page

This page contains the results from test suite $release_name of supported compilers.

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.
N.B. The detection of warnings is not exact. Look at the output to be sure!

  1. Platform Description
  2. Test Results
  3. The documentation of this release
    4. EOF #
  4. if (defined($opt_p)) { my $prev_page = result_filename($opt_p); print OUTPUT<<"EOF";
  5. Test Results $opt_p
    6. EOF } if ( -r "announce.html" ) { print OUTPUT<<"EOF";
  6. Annoucement of this release
    7. EOF } print OUTPUT<<'EOF';
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<(/)$><>; chdir $testresult_dir or die; 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<>; } else { search_previous_release(); } undef($opt_p) if (defined ($opt_p) and $opt_p =~ /^\s*$/); # init_known_platforms(); chdir $testresult_dir or die; chdir $release_name or die; choose_platforms(); chdir ".."; umask 0022; unlink $TEMPPAGE; unlink $TEMPPAGE2; open(OUTPUT,">$TEMPPAGE") or die; open(OUTPUTV,">$TEMPPAGE2") or die; chdir $testresult_dir or die; chdir $release_name or die; collect_results(); print_little_header(); # print_header(); chdir $testresult_dir or die; write_select(); chdir $release_name or die; print OUTPUT '

Platform Description and Summary

',"\n"; print_platform_descriptions(); print OUTPUT "

\n"; print_resultpage(); print OUTPUT "

\n"; close OUTPUT; chdir ".."; $VERSIONS_WEBPAGE="versions.html"; rename $TEMPPAGE, $WWWPAGE; rename $TEMPPAGE2, $VERSIONS_WEBPAGE; chmod 0664, $VERSIONS_WEBPAGE; 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 ''. "Matthias Baesken$qualification"; } elsif ($responsible eq 'spion') { return ''. "Sylvain Pion$qualification"; } elsif ($responsible eq 'rursu') { return ''. "Radu Ursu$qualification"; } elsif ($responsible eq 'yvinec') { return ''. "Mariette Yvinec$qualification"; } elsif ($responsible eq 'geert') { return ''. "Geert-Jan Giezeman$qualification"; } elsif ($responsible eq 'rineau') { return ''. "Laurent Rineau$qualification"; } elsif ($responsible eq 'hoffmann') { return ''. "Michael Hoffmann$qualification"; } elsif ($responsible eq 'hachenb') { return ''. "Peter Hachenberger$qualification"; } elsif ($responsible eq 'mkaravel') { return ''. "Menelaos Karavelas$qualification"; } elsif ($responsible eq 'afabri') { return ''. "Andreas Fabri$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() { ($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();