+++ /dev/null
-#! /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;
-}
projects / ptas / blobdiff