spectest_summary.pl

#!/usr/bin/perl

# NOTE: this script must be run from the root of the local Rakudo git repository

# This script wraps up all the bits and pieces used to get, build, and spec test
# Rakudo.
#
# The script optionally takes a single date argument of the format YYYY-mm-dd
# and builds a spectest summary for each day from that date to the last full day
# commit made to Rakudo. This is useful when generating spectest summary data
# over many days.
#
# The output is CSV data, designed for consumption by something like
# tools/progress-graph.pl
#
# Care is taken to build against the correct Rakudo version for the date
# (retrieved from a cloned git repository), and to test that against the
# correct test suite retrieved from a respective SVN revision. Not much care
# is taken elsewhere :)
#
# Example usage:
#   perl tools/spectest_summary.pl 2010-02-23
#

use strict;
use warnings;

use Carp qw(croak);
use File::Path;
use DateTime;

use constant DO_DELETES => 1;
use constant SIM => 0;

my $PERL           = q{/usr/bin/perl};
my $PARROT         = q{parrot};
my $PARROT_INSTALL = q{parrot_install};
my $SPECTEST       = q{t/spec};
my $SVN_SPECTEST   = q{http://svn.pugscode.org/pugs/t/spec};
my $SUMMARY_FILE   = q{spectest_summary.csv};

eval { main() };
if ($@) {
    print STDERR "ERROR: $@";
}


sub main {
    my $date = $ARGV[0] or croak "Please supply a date e.g. YYYY-mm-dd";

    my ($y, $m, $d) = split /-/, $date;
    my $past  = DateTime->new('year'  => $y,
                              'month' => $m,
                              'day'   => $d);
    my $today = DateTime->today;

    # clean up the previous run's spectest summary file
    remove([$SUMMARY_FILE]);

    while ($today >= $past) {
        my $formatted_date = $past->ymd('-');

        checkout_git_branch('master');
        my $git_commit = git_revision($past);

        make_clean();
        make_realclean();
        remove([$PARROT, $PARROT_INSTALL, $SPECTEST]);

        checkout_spectest($formatted_date);
        checkout_git_branch($git_commit, $formatted_date);

        build_rakudo();

        my $spectest_result = spectest();
        croak "No results retrieved for $formatted_date" if (! defined $spectest_result);

        # TODO: how to get the number of files?
        my $no_files = 0;

        print "Result: $spectest_result\n";
        my $result = massage_results($spectest_result,
                                     $git_commit,
                                     $past,
                                     $no_files);
        
        checkout_git_branch('master');
        open my $spectest_summary, ">>", $SUMMARY_FILE;
        print $spectest_summary "$result\n";
        close $spectest_summary;

        $past->add(days => 1);
    }
}

sub git_revision {
    my $day = shift;

    my $previous_day = $day->clone;
    $previous_day->subtract(days => 1);
    
    # It would be nice to use git to find the last commit for a given date
    # using something like git log --before=<date>, however this uses the local
    # timezone. Setting to the local timezone to UTC doesn't appear to do the
    # same thing as what pmichaud's existing dateset seems to assume, so
    # instead, we look for the first instance of a previous date in the git log
    # and use that commit
    #
    my $git_log_cmd = qq{git log --date=short};
    my $result = `$git_log_cmd 2>&1`;

    my ($commit, $author, $date);

    # TODO: potential infinite loop?
    while ( $result =~ m|^commit \s+ (.+)$|gmx ) {
        $commit = $1;

        $result =~ m|^Author: \s+ (.+)$|gmx;
        $author = $1;

        $result =~ m|^Date: \s+ (.+)$|gmx;
        $date = $1;

        my ($y, $m, $d) = split /-/, $date;
        my $commit_date = DateTime->new( year  => $y,
                                         month => $m,
                                         day   => $d );

        # if we've found the previous day's last commit
        # (or earlier if there wasn't one), we're done
        last if ($commit_date <= $previous_day);
    }

    if ( ! defined $commit |
         ! defined $author |
         ! defined $date )
    {
        croak "Couldn't find last git commit for date: $previous_day";
    }

    return $commit;
}

sub make_clean {
    my $make_clean_cmd = q{make clean};
    print "Going to make clean\n";
    run($make_clean_cmd);
}

sub make_realclean {
    my $make_real_clean_cmd = q{make realclean};
    print "Going to make realclean\n";
    run($make_real_clean_cmd);
}

sub remove {
    my $items = shift;
    print "Removing: @$items\n";
    map { `rm -rf $_` } @$items if (DO_DELETES && ! SIM);
    #rmtree($items) if (DO_DELETES && ! SIM);
}

sub checkout_spectest {
    my $date = shift;
    print "Checking out spectest from SVN\n";
    my $svn_checkout_cmd = qq|svn checkout --revision {$date} "$SVN_SPECTEST" $SPECTEST|;
    run($svn_checkout_cmd);
}

sub checkout_git_branch {
    my ($commit, $name) = (shift, shift);

    $name = $commit if (! defined $name);
    print "Checking out git commit: $commit, with name: $name\n";

    my $git_checkout_cmd      = qq{git checkout $commit};
    my $git_change_branch_cmd = qq{git checkout -b $name};

    run($git_checkout_cmd);
    run($git_change_branch_cmd);
}

sub build_rakudo {
    my $configure_cmd = qq{$PERL Configure.pl --gen-parrot};
    my $make_cmd      = q{make};

    print "Building rakudo\n";
    run($configure_cmd);
    run($make_cmd);
}

sub spectest {
    my $spectest_cmd = qq{$PERL tools/test_summary.pl};

    # build Test.pir
    run('make Test.pir');

    print "Running spec test summary\n";
    my $result = q{"total",0,0,0,0,0,0}; # dummy result set for SIM

    $result = `$spectest_cmd 2>&1` if (! SIM);
    $result =~ m|^("total",.*)$|m;

    my $total = $1;
    return $total;
}

sub massage_results {
    my ($spectest_result, $commit, $date, $no_files)  = @_;

    $commit =~ m|^(.{7})|;
    my $formatted_commit = $1;
    my $formatted_date   = $date->ymd('-') . ' ' . $date->hms;

    # we want a final result of the form
    #   26/02/10 00:00, 403afe0, revision, pass, fail, todo, skip, regr, spec, files
    my @data = split /\,/, $spectest_result;

    # throw away the "total" string
    shift @data;
    # add our commit/revision string
    unshift @data, $formatted_commit;
    # add our date
    unshift @data, qq{"$formatted_date"};
    # add the number of test files
    push @data, $no_files;

    my $result = join ',', @data;
    return $result;
}

sub run {
    my $cmd = shift;
    system $cmd if (! SIM);
}