mirror of
https://github.com/ioacademy-jikim/debugging
synced 2025-06-08 08:26:14 +00:00
479 lines
14 KiB
Perl
Executable File
479 lines
14 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
#-----------------------------------------------------------------
|
|
# Quick and dirty script to summarize build information for a
|
|
# set of nightly runs.
|
|
#
|
|
# The results of the nighly regression runs are extracted from
|
|
# the GMANE mail archive. The URL for a given mail sent to the
|
|
# valgrind-developers mailing list is
|
|
#
|
|
# http://article.gmane.org/gmane.comp.debugging.valgrind.devel/<integer>
|
|
#
|
|
# The script extracts information about the regression run from a
|
|
# block of information at the beginning of the mail. That information
|
|
# was added beginning October 4, 2011. Therefore, only regression runs
|
|
# from that date or later can be analyzed.
|
|
#
|
|
# There is unfortunately no good way of figuring out the interval
|
|
# of integers in the above URL that include all nightly regression
|
|
# runs.
|
|
#
|
|
# The function get_regtest_data does all the work. It returns a hash
|
|
# whose keys are the dates at which nightly runs took place. The value
|
|
# is in turn a hash.
|
|
#
|
|
# Each such hash has the following keys:
|
|
# "builds" array of hashes
|
|
# "num_builds" int
|
|
# "num_failing_builds" int
|
|
# "num_passing_builds" int
|
|
# "num_testcase_failures" int
|
|
# "num_failing_testcases" int
|
|
# "failure_frequency" hash indexed by testcase name; value = int
|
|
#
|
|
# "builds" is an array of hashes with the following keys
|
|
# "arch" string (architecture)
|
|
# "distro" string (distribution, e.g. Fedora-15)
|
|
# "failures" array of strings (failing testcases)
|
|
# "valgrind revision" integer
|
|
# "VEX revision" integer
|
|
# "GCC version" string
|
|
# "C library" string
|
|
# "uname -mrs" string
|
|
# "Vendor version" string
|
|
#
|
|
#-----------------------------------------------------------------
|
|
use strict;
|
|
use warnings;
|
|
|
|
use LWP::Simple;
|
|
use Getopt::Long;
|
|
|
|
my $prog_name = "nightly-build-summary";
|
|
|
|
my $debug = 0;
|
|
my $keep = 0;
|
|
|
|
my $usage=<<EOF;
|
|
USAGE
|
|
|
|
$prog_name
|
|
|
|
--from=INTEGER beginning of mail interval; > 14800
|
|
|
|
[--to=INTEGER] end of mail interval; default = from + 100
|
|
|
|
[--debug] verbose mode (debugging)
|
|
|
|
[--keep] write individual emails to files (debugging)
|
|
|
|
[--dump] write results suitable for post-processing
|
|
|
|
[--readable] write results in human readable form (default)
|
|
|
|
EOF
|
|
|
|
|
|
#-----------------------------------------------------------------
|
|
# Search for a line indicating that this is an email containing
|
|
# the results of a valgrind regression run.
|
|
# Return 1, if found and 0 oherwise.
|
|
#-----------------------------------------------------------------
|
|
sub is_regtest_result {
|
|
my (@lines) = @_;
|
|
|
|
foreach my $line (@lines) {
|
|
return 1 if ($line =~ "^valgrind revision:");
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
|
|
#-----------------------------------------------------------------
|
|
# Extract information from the run. Don't prep the data here. This
|
|
# is done later on.
|
|
#-----------------------------------------------------------------
|
|
sub get_raw_data {
|
|
my (@lines, $msgno) = @_;
|
|
my ($i, $n, $line, $date);
|
|
|
|
$n = scalar @lines;
|
|
|
|
my %hash = ();
|
|
|
|
# 1) Locate the section with the info about the environment of this nightly run
|
|
for ($i = 0; $i < $n; ++$i) {
|
|
last if ($lines[$i] =~ /^valgrind revision:/);
|
|
}
|
|
die "no info block in message $msgno" if ($i == $n);
|
|
|
|
# 2) Read the info about the build: compiler, valgrind revision etc.
|
|
# and put it into a hash.
|
|
for ( ; $i < $n; ++$i) {
|
|
$line = $lines[$i];
|
|
last if ($line =~ /^$/); # empty line indicates end of section
|
|
my ($key, $value) = split(/:/, $line);
|
|
$value =~ s/^[ ]*//; # removing leading blanks
|
|
$hash{$key} = $value;
|
|
}
|
|
|
|
if ($debug) {
|
|
foreach my $key (keys %hash) {
|
|
my ($val) = $hash{$key};
|
|
print "regtest env: KEY = |$key| VAL = |$val|\n";
|
|
}
|
|
}
|
|
|
|
# 3) Get the date from when the build was kicked off.
|
|
for ( ; $i < $n; ++$i) {
|
|
$line = $lines[$i];
|
|
|
|
if ($line =~ /^Started at[ ]+([^ ]+)/) {
|
|
$date = $1;
|
|
print "DATE = $date\n";
|
|
last;
|
|
}
|
|
}
|
|
die "no date found in message $msgno" if ($i == $n);
|
|
|
|
|
|
# 4) Find out if the regression run failed or passed
|
|
$hash{"failures"} = [];
|
|
for ($i = $i + 1; $i < $n; ++$i) {
|
|
$line = $lines[$i];
|
|
if ($line =~ /Running regression tests/) {
|
|
return %hash if ($line =~ /done$/); # regtest succeeded; no failures
|
|
die "cannot determine regtest outcome for message $msgno"
|
|
if (! ($line =~ /failed$/));
|
|
last;
|
|
}
|
|
}
|
|
|
|
# 5) Regtest failed; locate the section with the list of failing testcases
|
|
for ($i = $i + 1; $i < $n; ++$i) {
|
|
$line = $lines[$i];
|
|
# Match for end-of-line == because line might be split.
|
|
last if ($line =~ /==$/);
|
|
}
|
|
die "cannot locate failing testcases in message $msgno" if ($i == $n);
|
|
|
|
# 6) Get list of failing testcases
|
|
for ($i = $i + 1; $i < $n; ++$i) {
|
|
$line = $lines[$i];
|
|
|
|
last if ($line =~ /^$/);
|
|
|
|
my ($testcase) = (split(/\s+/, $line))[0];
|
|
print "ADD failing testcase $testcase\n" if ($debug);
|
|
push @{$hash{"failures"}}, $testcase;
|
|
}
|
|
|
|
return ($date, %hash);
|
|
}
|
|
|
|
|
|
#-----------------------------------------------------------------
|
|
# Extract architecture; get a pretty name for the distro
|
|
#-----------------------------------------------------------------
|
|
sub prep_regtest_data {
|
|
my (%hash) = @_;
|
|
my ($val, $arch, $distro);
|
|
|
|
$val = $hash{"uname -mrs"};
|
|
die "uname -mrs info is missing" if (! defined $val);
|
|
$arch = (split(/ /, $val))[2];
|
|
|
|
$val = $hash{"Vendor version"};
|
|
die "Vendor version info is missing" if (! defined $val);
|
|
|
|
if ($val =~ /Fedora release ([0-9]+)/) {
|
|
$distro = "Fedora-$1";
|
|
} elsif ($val =~ /openSUSE ([0-9]+)\.([0-9]+)/) {
|
|
$distro = "openSUSE-$1.$2";
|
|
} elsif ($val =~ /SUSE Linux Enterprise Server 11 SP1/) {
|
|
$distro = "SLES-11-SP1";
|
|
} elsif ($val =~ /Red Hat Enterprise Linux AS release 4/) {
|
|
$distro = "RHEL-4";
|
|
} else {
|
|
$distro = "UNKNOWN";
|
|
}
|
|
|
|
# Add architecture and distribution to hash
|
|
$hash{"arch"} = $arch;
|
|
$hash{"distro"} = $distro;
|
|
|
|
return %hash;
|
|
}
|
|
|
|
|
|
#-----------------------------------------------------------------
|
|
# Precompute some summary information and record it
|
|
#-----------------------------------------------------------------
|
|
sub precompute_summary_info
|
|
{
|
|
my (%dates) = @_;
|
|
|
|
foreach my $date (sort keys %dates) {
|
|
my %failure_frequency = ();
|
|
|
|
my %nightly = %{ $dates{$date} };
|
|
my @builds = @{ $nightly{"builds"} };
|
|
|
|
$nightly{"num_builds"} = scalar (@builds);
|
|
$nightly{"num_failing_builds"} = 0;
|
|
$nightly{"num_testcase_failures"} = 0;
|
|
|
|
foreach my $build (@builds) {
|
|
my %regtest_data = %{ $build };
|
|
|
|
my @failures = @{ $regtest_data{"failures"} };
|
|
my $num_fail = scalar (@failures);
|
|
|
|
++$nightly{"num_failing_builds"} if ($num_fail != 0);
|
|
$nightly{"num_testcase_failures"} += $num_fail;
|
|
|
|
# Compute how often a testcase failed
|
|
foreach my $test ( @failures ) {
|
|
if (defined $failure_frequency{$test}) {
|
|
++$failure_frequency{$test};
|
|
} else {
|
|
$failure_frequency{$test} = 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
$nightly{"num_passing_builds"} =
|
|
$nightly{"num_builds"} - $nightly{"num_failing_builds"};
|
|
|
|
$nightly{"num_failing_testcases"} = scalar (keys %failure_frequency);
|
|
|
|
$nightly{"failure_frequency"} = { %failure_frequency };
|
|
|
|
$dates{$date} = { %nightly };
|
|
}
|
|
|
|
return %dates;
|
|
}
|
|
|
|
|
|
#-----------------------------------------------------------------
|
|
# Get messages from GMANE, and build up a database of results.
|
|
#-----------------------------------------------------------------
|
|
sub get_regtest_data {
|
|
my ($from, $to) = @_;
|
|
|
|
my $url_base = "http://article.gmane.org/gmane.comp.debugging.valgrind.devel/";
|
|
|
|
my %dates = ();
|
|
|
|
my $old_date = "-1";
|
|
my @builds = ();
|
|
|
|
for (my $i = $from; $i <= $to; ++$i) {
|
|
my $url = "$url_base" . "$i";
|
|
|
|
my $page = get("$url");
|
|
|
|
if ($keep) {
|
|
open (EMAIL, ">$i");
|
|
print EMAIL $page;
|
|
close(EMAIL);
|
|
}
|
|
|
|
# Detect if the article does not exist. Happens for too large --to= values
|
|
last if ($page eq "No such file.\n");
|
|
|
|
# Split the page into lines
|
|
my @lines = split(/\n/, $page);
|
|
|
|
# Check whether it contains a regression test result
|
|
next if (! is_regtest_result(@lines));
|
|
print "message $i is a regression test result\n" if ($debug);
|
|
|
|
# Get the raw data
|
|
my ($date, %regtest_data) = get_raw_data(@lines);
|
|
|
|
%regtest_data = prep_regtest_data(%regtest_data);
|
|
|
|
if ($date ne $old_date) {
|
|
my %nightly = ();
|
|
$nightly{"builds"} = [ @builds ];
|
|
$dates{$old_date} = { %nightly } if ($old_date ne "-1");
|
|
|
|
$old_date = $date;
|
|
@builds = ();
|
|
}
|
|
|
|
push @builds, { %regtest_data };
|
|
}
|
|
my %nightly = ();
|
|
$nightly{"builds"} = [ @builds ];
|
|
$dates{$old_date} = { %nightly } if ($old_date ne "-1");
|
|
|
|
# Convenience: precompute some info we'll be interested in
|
|
%dates = precompute_summary_info( %dates );
|
|
|
|
return %dates;
|
|
}
|
|
|
|
|
|
#-----------------------------------------------------------------
|
|
# Write out the results in a form suitable for automatic post-processing
|
|
#-----------------------------------------------------------------
|
|
sub dump_results {
|
|
my (%dates) = @_;
|
|
|
|
foreach my $date (sort keys %dates) {
|
|
|
|
my %nightly = %{ $dates{$date} };
|
|
my @builds = @{ $nightly{"builds"} };
|
|
|
|
foreach my $build (@builds) {
|
|
my %regtest_data = %{ $build };
|
|
|
|
my $arch = $regtest_data{"arch"};
|
|
my $distro = $regtest_data{"distro"};
|
|
my @failures = @{ $regtest_data{"failures"} };
|
|
my $num_fail = scalar (@failures);
|
|
my $fails = join(":", sort @failures);
|
|
|
|
printf("Regrun: %s %3d %-10s %-20s %s\n",
|
|
$date, $num_fail, $arch, $distro, $fails);
|
|
}
|
|
|
|
my %failure_frequency = %{ $nightly{"failure_frequency"} };
|
|
|
|
foreach my $test (keys %failure_frequency) {
|
|
printf("Test: %s %3d %s\n",
|
|
$date, $failure_frequency{$test}, $test);
|
|
}
|
|
|
|
printf("Total: %s builds: %d %d fail %d pass tests: %d fail %d unique\n",
|
|
$date, $nightly{"num_builds"}, $nightly{"num_failing_builds"},
|
|
$nightly{"num_passing_builds"}, $nightly{"num_testcase_failures"},
|
|
$nightly{"num_failing_testcases"});
|
|
}
|
|
}
|
|
|
|
|
|
sub write_readable_results {
|
|
my (%dates) = @_;
|
|
|
|
foreach my $date (sort keys %dates) {
|
|
my %nightly = %{ $dates{$date} };
|
|
|
|
print "$date\n----------\n";
|
|
|
|
printf("%3d builds\n", $nightly{"num_builds"});
|
|
printf("%3d builds fail\n", $nightly{"num_failing_builds"});
|
|
printf("%3d builds pass\n", $nightly{"num_passing_builds"});
|
|
print "\n";
|
|
printf("%3d testcase failures (across all runs)\n",
|
|
$nightly{"num_testcase_failures"});
|
|
printf("%3d failing testcases (unique)\n",
|
|
$nightly{"num_failing_testcases"});
|
|
print "\n";
|
|
|
|
my @builds = @{ $nightly{"builds"} };
|
|
|
|
if ($nightly{"num_passing_builds"} != 0) {
|
|
print "Passing builds\n";
|
|
print "--------------\n";
|
|
foreach my $build (@builds) {
|
|
my %regtest_data = %{ $build };
|
|
my @failures = @{ $regtest_data{"failures"} };
|
|
my $num_fail = scalar (@failures);
|
|
|
|
if ($num_fail == 0) {
|
|
my $arch = $regtest_data{"arch"};
|
|
my $distro = $regtest_data{"distro"};
|
|
|
|
printf("%-8s %-15s\n", $arch, $distro);
|
|
}
|
|
print "\n";
|
|
}
|
|
print "\n";
|
|
}
|
|
|
|
if ($nightly{"num_failing_builds"} != 0) {
|
|
print "Failing builds\n";
|
|
print "--------------\n";
|
|
foreach my $build (@builds) {
|
|
my %regtest_data = %{ $build };
|
|
my @failures = @{ $regtest_data{"failures"} };
|
|
my $num_fail = scalar (@failures);
|
|
|
|
if ($num_fail != 0) {
|
|
my $arch = $regtest_data{"arch"};
|
|
my $distro = $regtest_data{"distro"};
|
|
|
|
printf("%-8s %-15s %d failures\n", $arch, $distro, $num_fail);
|
|
foreach my $test (@failures) {
|
|
print " $test\n";
|
|
}
|
|
print "\n";
|
|
}
|
|
}
|
|
print "\n";
|
|
}
|
|
|
|
print "Failing testcases and their frequency\n";
|
|
print "-------------------------------------\n";
|
|
my %failure_frequency = %{ $nightly{"failure_frequency"} };
|
|
|
|
# Sorted in decreasing frequency
|
|
foreach my $test (sort {$failure_frequency{$b} cmp $failure_frequency{$a} }
|
|
keys %failure_frequency) {
|
|
printf("%3d %s\n", $failure_frequency{$test}, $test);
|
|
}
|
|
print "\n";
|
|
}
|
|
}
|
|
|
|
|
|
sub main
|
|
{
|
|
my ($from, $to, $dump, $readable);
|
|
|
|
$from = $to = 0;
|
|
$dump = $readable = 0;
|
|
|
|
GetOptions( "from=i" => \$from,
|
|
"to=i" => \$to,
|
|
"debug" => \$debug,
|
|
"dump" => \$dump,
|
|
"keep" => \$keep,
|
|
"readable" => \$readable
|
|
) || die $usage;
|
|
|
|
# 14800 is about Oct 4, 2011 which is when we began including information
|
|
# about the environment
|
|
|
|
die $usage if ($from < 14800);
|
|
|
|
$to = $from + 100 if ($to == 0);
|
|
|
|
if ($from > $to) {
|
|
print STDERR "*** invalid [from,to] interval. Try again\n";
|
|
die $usage;
|
|
}
|
|
|
|
$readable = 1 if ($dump == 0 && $readable == 0);
|
|
|
|
print "check message interval [$from...$to]\n" if ($debug);
|
|
|
|
# Get mails from GMANE mail archive
|
|
|
|
my %dates = get_regtest_data($from, $to);
|
|
|
|
dump_results(%dates) if ($dump);
|
|
|
|
write_readable_results(%dates) if ($readable);
|
|
}
|
|
|
|
main();
|
|
|
|
exit 0;
|