#! /usr/bin/perl
require 5.008_004; # we need at least Perl version v5.8.4
$ENV{MALLOC_CHECK_} = 2;

use Term::ANSIColor;

my $startTime = time();

my %opts = (
    "a" => 0, # all directories, irrespective of if they're in tests.pro
    "r" => 0, # don't reverse sort
    "s" => "D", # by default, sort by directory name
    "j" => 1, # one make job at a time by default
);

for ( my $argNo=0; $argNo<@ARGV; $argNo++ ) {
    my $arg = $ARGV[ $argNo ];
    if ( $arg eq "-h" ) {
        print "usage: $0 [-a] [-s letter] [-r] [-j number] [-h]\n";
        print "       -a            include all ut_*/ directories - default is just the ones in tests.pro\n";
        print "       -s [DTPFS]    sort by column (Dirs, Tests, P(ass), F(ail), S(kipped)\n";
        print "       -r            reverse sort\n";
        print "       -j <number>   use <number> make jobs. Default is 1\n";
        print "       -h            this help\n";
        exit;
    } elsif ( $arg eq "-r" ) {
        $opts{ "r" } = 1;
    } elsif ( $arg eq "-a" ) {
        $opts{ "a" } = 1;
    } elsif ( $arg eq "-s" ) {
        $opts{ "s" } = $ARGV[ ++$argNo ];
        if ( $opts{ "s" } !~ /[DTPFS]/ ) {
            print "Unrecognised column identifier\n";
            print "Must be one of [DTPFS] :\n";
            print "  D = Dirs\n";
            print "  T = Tests\n";
            print "  P = Pass\n";
            print "  F = Fail\n";
            print "  S = Skipped\n";
            exit(-1);
        }
    } elsif ( $arg eq "-j" ) {
        my $jobs = $ARGV[ ++$argNo ];
        # Test that the argument is a positive integer number
        if ( $jobs * 1 eq $jobs && $jobs > 0 ) {
            $opts{ "j" } = $jobs;
        }
    }
}

# some globals to help sort be faster
$sortCol = $opts{ "s" };
$sortIsNumeric = ( $sortCol =~ /[PFS]/ );
$reverseSort = $opts{ "r" };
# helper variable for the number of jobs
$numJobs = $opts{ "j" };

%maxLen = ();
%segFault = ();

my @rowHeaders = (
    "D", # Dirs
    "T", # Tests
);
my @rowData = (
    "P", # Passed
    "F", # Failed
    "S", # Skipped
);

my @keys = ( @rowHeaders, @rowData );

my %title = (
    "D"=>"Dirs",
    "T"=>"Tests",
    "P"=>"P",
    "F"=>"F",
    "S"=>"S",
);

my $headerLabelFormat = "%-*s";
my $headerDataFormat = "%*s";

my $labelFormat = "%s%-*s%s%*s";
my $dataFormat   = "%*s%s%*s%s";

my %format = (
  "D" => $labelFormat,
  "T" => $labelFormat,
  "P" => $dataFormat,
  "F" => $dataFormat,
  "S" => $dataFormat,
);

my %separator = (
  "D" => " ",
  "T" => " : ",
  "P" => " ",
  "F" => " ",
  "S" => " ",
);

my %data = (
);

foreach $key ( @keys ) {
    $maxLen{ $key } = length( $title{ key } );
}

# set the maximum length of the directories
if ( $opts{ "a" } ) {
    push @allDirs, <ut_*>;
    push @allDirs, <ft_*>;
    foreach ( @allDirs ) {
        setMaxLen( "D", length( $_ ) );
        $tested{ $_ } = 0;
    }
}

# Compile first with possibly multiple jobs
print "Compiling...";
`make -j$numJobs -k > /dev/null 2>&1`;
print "done.\nNow checking...\n";

# then check with only one job so that the parsing succeeds
open( MAKE, "make -k check 2>&1|" ) || die( "Could not run make:$!" );

#$|=1;

my $thisDir = "";
while (<MAKE>) {
    chomp;

    if ( /Entering directory \`.*tests\/(\w+)\'/ ) {
        $thisDir = $1;
        print STDERR "Tests: $thisDir", ' 'x( $maxLen{ "D" }-length( $thisDir )+length("Tests: ") ), "\r";
        $tested{ $thisDir } = 1;
        push @allDirs, $thisDir if ( !grep( /^$thisDir$/, @allDirs ) );
        setMaxLen( "D", length( $thisDir ) );
    } elsif ( /Segmentation fault/ ) {
        $segFault{ $thisDir } = $_;
    } elsif ( /Start testing of (\w+)/ ) {
        $thisTest = $1;
        $data{ "T" }{ $thisDir } = $thisTest;
        setMaxLen( "T", length( $data{ "T" }{ $thisDir } ) );
    } elsif ( /^Totals: (\d+) passed, (\d+) failed, (\d+) skipped/ ) {
        $data{ "P" }{ $thisDir } = "$1";
        $data{ "F" }{ $thisDir } = "$2";
        $data{ "S" }{ $thisDir } = "$3";
        setMaxLen( "P", length( $data{ "P" }{ $thisDir } ) );
        setMaxLen( "F", length( $data{ "F" }{ $thisDir } ) );
        setMaxLen( "S", length( $data{ "S" }{ $thisDir } ) );
    }
}

close( MAKE );

print STDERR ' 'x( $maxLen{ "D" } + length( "Tests: " ) ), "\r";

foreach $thisDir ( @allDirs ) {
    if ( !defined( $data{ "P" }{ $thisDir } ) || $data{ "P" }{ $thisDir } eq "" ) {
        $data{ "P" }{ $thisDir } = "0";
        setMaxLen( "P", length( $data{ "P" }{ $thisDir } ) );
    }
    if ( !defined( $data{ "F" }{ $thisDir } ) ) {
        $data{ "F" }{ $thisDir } = "0";
        setMaxLen( "F", length( $data{ "F" }{ $thisDir } ) );
    }
    if ( !defined( $data{ "S" }{ $thisDir } ) ) {
        $data{ "S" }{ $thisDir } = "0";
        setMaxLen( "S", length( $data{ "S" }{ $thisDir } ) );
    }

    $data{ "D" }{ $thisDir } = $thisDir;
}

my ( $testsPassed, $testsNeedWork ) = ( 0, 0 );
my $noTests = scalar( @allDirs );
my $noDigits = ($noTests>0)?int( log( $noTests )/log( 10 ) )+1:1;

my $header = sprintf( "%*s ", $noDigits, "" );

foreach ( @rowHeaders ) {
    $header .= sprintf( $headerLabelFormat.$separator{ $_ }, $maxLen{ $_ }, $title{ $_ } );
}

foreach ( @rowData ) {
    $header .= sprintf( $headerDataFormat.$separator{ $_ }, $maxLen{ $_ }, $title{ $_ } );
}

my $headerLen = length( $header );

my $headerColor = color( 'reset' );

print "P = Pass, F = Fail, S = Skip\n";
print $headerColor, "$header\n";
print '-'x$headerLen, "\n";

my $testNo = 1;

foreach $thisDir ( sort byCol @allDirs ) {
    my %colors = ();

    foreach $key ( @keys ) {
        $colors{ $key } = color( 'reset' );
    }

    if (
        ( defined( $data{ "P" }{ $thisDir } ) && $data{ "P" }{ $thisDir } ne "0" ) &&
        ( defined( $data{ "F" }{ $thisDir } ) && $data{ "F" }{ $thisDir } eq "0" ) &&
        ( defined( $data{ "S" }{ $thisDir } ) && $data{ "S" }{ $thisDir } eq "0" ) &&
        ( defined( $data{ "T" }{ $thisDir } ) && $data{ "T" }{ $thisDir } ne "" )
    ) {
        $testsPassed++;
    } else {
        $testsNeedWork++;
    }

    if ( defined( $data{ "P" }{ $thisDir } ) && $data{ "P" }{ $thisDir } eq "0" ) {
        $colors{ "D" } .= color( 'reverse green' );
        $colors{ "T" } .= color( 'reverse green' );
        $colors{ "P" } .= color( 'reverse green' );
    } else {
        $colors{ "D" } .= color( 'green' );
        $colors{ "T" } .= color( 'green' );
        $colors{ "P" } .= color( 'green' );
    }

    if ( defined( $data{ "F" }{ $thisDir} ) && $data{ "F" }{ $thisDir } eq "0" ) {
        $colors{ "F" } .= color( 'red' );
    } else {
        $colors{ "F" } .= color( 'reverse red' );
    }

    if ( defined( $data{ "S" }{ $thisDir } ) && $data{ "S" }{ $thisDir } eq "0" ) {
        $colors{ "S" } .= color( 'blue' );
    } else {
        $colors{ "S" } .= color( 'reverse blue' );
    }

    if ( !defined( $data{ "T" }{ $thisDir } ) || $data{ "T" }{ $thisDir } eq "" || $segFault{ $thisDir } ) {
        $colors{ "T" } .= color( 'reverse red' );
    }

    printf( "%*s ", $noDigits, $testNo );

    foreach ( @rowHeaders ) {
        my $thisData = $data{ $_ }{ $thisDir };
        my $dataLength = length( $thisData );
        my $spaceLength = $maxLen{ $_ }-$dataLength;

        printf(
            $format{ $_ }.$separator{ $_ },
            $colors{ $_ }, $dataLength, $thisData,
            color( 'reset' ), $spaceLength, "" );
    }

    foreach ( @rowData ) {
        my $thisData = $data{ $_ }{ $thisDir };
        my $dataLength = length( $thisData );
        my $spaceLength = $maxLen{ $_ }-$dataLength;

        printf(
            $format{ $_ }.$separator{ $_ },
            $spaceLength, "",
            $colors{ $_ }, $dataLength, $thisData,
            color( 'reset' ) );
    }

    printf( $headerColor."\n" );

    $testNo++;
}

print '-'x$headerLen, "\n";
print( "Tests with zero fails/skips : $testsPassed\n" );
print( "Tests needing further work  : $testsNeedWork\n" );

printf( "Elapsed time : %d seconds\n", time() - $startTime );

sub setMaxLen
{
    my ( $test, $length ) = @_;

    $maxLen{ $test } = $length if ( defined( $maxLen{ $test} ) && $length > $maxLen{ $test } );
}

sub byCol
{
    my $retVal = 0;

    my $localA = $a;
    my $localB = $b;

    if ( $reverseSort ) {
        my $tmp = $localA;
        $localA = $localB;
        $localB = $tmp;
    }

    if ( $sortIsNumeric ) {
        # numeric comparison
        $retVal = $data{ $sortCol }{ $localA } <=> $data{ $sortCol }{ $localB };
    } else {
        # string comparison
        $retVal = $data{ $sortCol }{ $localA } cmp $data{ $sortCol }{ $localB };
    }

    return $retVal;
}