git.maemo.org Git - ptas/blob - tests/testSummary

   1 #! /usr/bin/perl
   2 require 5.008_004; # we need at least Perl version v5.8.4
   3 $ENV{MALLOC_CHECK_} = 2;
   4
   5 use Term::ANSIColor;
   6
   7 my $startTime = time();
   8
   9 my %opts = (
  10     "a" => 0, # all directories, irrespective of if they're in tests.pro
  11     "r" => 0, # don't reverse sort
  12     "s" => "D", # by default, sort by directory name
  13     "j" => 1, # one make job at a time by default
  14 );
  15
  16 for ( my $argNo=0; $argNo<@ARGV; $argNo++ ) {
  17     my $arg = $ARGV[ $argNo ];
  18     if ( $arg eq "-h" ) {
  19         print "usage: $0 [-a] [-s letter] [-r] [-j number] [-h]\n";
  20         print "       -a            include all ut_*/ directories - default is just the ones in tests.pro\n";
  21         print "       -s [DTPFS]    sort by column (Dirs, Tests, P(ass), F(ail), S(kipped)\n";
  22         print "       -r            reverse sort\n";
  23         print "       -j <number>   use <number> make jobs. Default is 1\n";
  24         print "       -h            this help\n";
  25         exit;
  26     } elsif ( $arg eq "-r" ) {
  27         $opts{ "r" } = 1;
  28     } elsif ( $arg eq "-a" ) {
  29         $opts{ "a" } = 1;
  30     } elsif ( $arg eq "-s" ) {
  31         $opts{ "s" } = $ARGV[ ++$argNo ];
  32         if ( $opts{ "s" } !~ /[DTPFS]/ ) {
  33             print "Unrecognised column identifier\n";
  34             print "Must be one of [DTPFS] :\n";
  35             print "  D = Dirs\n";
  36             print "  T = Tests\n";
  37             print "  P = Pass\n";
  38             print "  F = Fail\n";
  39             print "  S = Skipped\n";
  40             exit(-1);
  41         }
  42     } elsif ( $arg eq "-j" ) {
  43         my $jobs = $ARGV[ ++$argNo ];
  44         # Test that the argument is a positive integer number
  45         if ( $jobs * 1 eq $jobs && $jobs > 0 ) {
  46             $opts{ "j" } = $jobs;
  47         }
  48     }
  49 }
  50
  51 # some globals to help sort be faster
  52 $sortCol = $opts{ "s" };
  53 $sortIsNumeric = ( $sortCol =~ /[PFS]/ );
  54 $reverseSort = $opts{ "r" };
  55 # helper variable for the number of jobs
  56 $numJobs = $opts{ "j" };
  57
  58 %maxLen = ();
  59 %segFault = ();
  60
  61 my @rowHeaders = (
  62     "D", # Dirs
  63     "T", # Tests
  64 );
  65 my @rowData = (
  66     "P", # Passed
  67     "F", # Failed
  68     "S", # Skipped
  69 );
  70
  71 my @keys = ( @rowHeaders, @rowData );
  72
  73 my %title = (
  74     "D"=>"Dirs",
  75     "T"=>"Tests",
  76     "P"=>"P",
  77     "F"=>"F",
  78     "S"=>"S",
  79 );
  80
  81 my $headerLabelFormat = "%-*s";
  82 my $headerDataFormat = "%*s";
  83
  84 my $labelFormat = "%s%-*s%s%*s";
  85 my $dataFormat   = "%*s%s%*s%s";
  86
  87 my %format = (
  88   "D" => $labelFormat,
  89   "T" => $labelFormat,
  90   "P" => $dataFormat,
  91   "F" => $dataFormat,
  92   "S" => $dataFormat,
  93 );
  94
  95 my %separator = (
  96   "D" => " ",
  97   "T" => " : ",
  98   "P" => " ",
  99   "F" => " ",
 100   "S" => " ",
 101 );
 102
 103 my %data = (
 104 );
 105
 106 foreach $key ( @keys ) {
 107     $maxLen{ $key } = length( $title{ key } );
 108 }
 109
 110 # set the maximum length of the directories
 111 if ( $opts{ "a" } ) {
 112     push @allDirs, <ut_*>;
 113     push @allDirs, <ft_*>;
 114     foreach ( @allDirs ) {
 115         setMaxLen( "D", length( $_ ) );
 116         $tested{ $_ } = 0;
 117     }
 118 }
 119
 120 # Compile first with possibly multiple jobs
 121 print "Compiling...";
 122 `make -j$numJobs -k > /dev/null 2>&1`;
 123 print "done.\nNow checking...\n";
 124
 125 # then check with only one job so that the parsing succeeds
 126 open( MAKE, "make -k check 2>&1|" ) || die( "Could not run make:$!" );
 127
 128 #$|=1;
 129
 130 my $thisDir = "";
 131 while (<MAKE>) {
 132     chomp;
 133
 134     if ( /Entering directory \`.*tests\/(\w+)\'/ ) {
 135         $thisDir = $1;
 136         print STDERR "Tests: $thisDir", ' 'x( $maxLen{ "D" }-length( $thisDir )+length("Tests: ") ), "\r";
 137         $tested{ $thisDir } = 1;
 138         push @allDirs, $thisDir if ( !grep( /^$thisDir$/, @allDirs ) );
 139         setMaxLen( "D", length( $thisDir ) );
 140     } elsif ( /Segmentation fault/ ) {
 141         $segFault{ $thisDir } = $_;
 142     } elsif ( /Start testing of (\w+)/ ) {
 143         $thisTest = $1;
 144         $data{ "T" }{ $thisDir } = $thisTest;
 145         setMaxLen( "T", length( $data{ "T" }{ $thisDir } ) );
 146     } elsif ( /^Totals: (\d+) passed, (\d+) failed, (\d+) skipped/ ) {
 147         $data{ "P" }{ $thisDir } = "$1";
 148         $data{ "F" }{ $thisDir } = "$2";
 149         $data{ "S" }{ $thisDir } = "$3";
 150         setMaxLen( "P", length( $data{ "P" }{ $thisDir } ) );
 151         setMaxLen( "F", length( $data{ "F" }{ $thisDir } ) );
 152         setMaxLen( "S", length( $data{ "S" }{ $thisDir } ) );
 153     }
 154 }
 155
 156 close( MAKE );
 157
 158 print STDERR ' 'x( $maxLen{ "D" } + length( "Tests: " ) ), "\r";
 159
 160 foreach $thisDir ( @allDirs ) {
 161     if ( !defined( $data{ "P" }{ $thisDir } ) || $data{ "P" }{ $thisDir } eq "" ) {
 162         $data{ "P" }{ $thisDir } = "0";
 163         setMaxLen( "P", length( $data{ "P" }{ $thisDir } ) );
 164     }
 165     if ( !defined( $data{ "F" }{ $thisDir } ) ) {
 166         $data{ "F" }{ $thisDir } = "0";
 167         setMaxLen( "F", length( $data{ "F" }{ $thisDir } ) );
 168     }
 169     if ( !defined( $data{ "S" }{ $thisDir } ) ) {
 170         $data{ "S" }{ $thisDir } = "0";
 171         setMaxLen( "S", length( $data{ "S" }{ $thisDir } ) );
 172     }
 173
 174     $data{ "D" }{ $thisDir } = $thisDir;
 175 }
 176
 177 my ( $testsPassed, $testsNeedWork ) = ( 0, 0 );
 178 my $noTests = scalar( @allDirs );
 179 my $noDigits = ($noTests>0)?int( log( $noTests )/log( 10 ) )+1:1;
 180
 181 my $header = sprintf( "%*s ", $noDigits, "" );
 182
 183 foreach ( @rowHeaders ) {
 184     $header .= sprintf( $headerLabelFormat.$separator{ $_ }, $maxLen{ $_ }, $title{ $_ } );
 185 }
 186
 187 foreach ( @rowData ) {
 188     $header .= sprintf( $headerDataFormat.$separator{ $_ }, $maxLen{ $_ }, $title{ $_ } );
 189 }
 190
 191 my $headerLen = length( $header );
 192
 193 my $headerColor = color( 'reset' );
 194
 195 print "P = Pass, F = Fail, S = Skip\n";
 196 print $headerColor, "$header\n";
 197 print '-'x$headerLen, "\n";
 198
 199 my $testNo = 1;
 200
 201 foreach $thisDir ( sort byCol @allDirs ) {
 202     my %colors = ();
 203
 204     foreach $key ( @keys ) {
 205         $colors{ $key } = color( 'reset' );
 206     }
 207
 208     if (
 209         ( defined( $data{ "P" }{ $thisDir } ) && $data{ "P" }{ $thisDir } ne "0" ) &&
 210         ( defined( $data{ "F" }{ $thisDir } ) && $data{ "F" }{ $thisDir } eq "0" ) &&
 211         ( defined( $data{ "S" }{ $thisDir } ) && $data{ "S" }{ $thisDir } eq "0" ) &&
 212         ( defined( $data{ "T" }{ $thisDir } ) && $data{ "T" }{ $thisDir } ne "" )
 213     ) {
 214         $testsPassed++;
 215     } else {
 216         $testsNeedWork++;
 217     }
 218
 219     if ( defined( $data{ "P" }{ $thisDir } ) && $data{ "P" }{ $thisDir } eq "0" ) {
 220         $colors{ "D" } .= color( 'reverse green' );
 221         $colors{ "T" } .= color( 'reverse green' );
 222         $colors{ "P" } .= color( 'reverse green' );
 223     } else {
 224         $colors{ "D" } .= color( 'green' );
 225         $colors{ "T" } .= color( 'green' );
 226         $colors{ "P" } .= color( 'green' );
 227     }
 228
 229     if ( defined( $data{ "F" }{ $thisDir} ) && $data{ "F" }{ $thisDir } eq "0" ) {
 230         $colors{ "F" } .= color( 'red' );
 231     } else {
 232         $colors{ "F" } .= color( 'reverse red' );
 233     }
 234
 235     if ( defined( $data{ "S" }{ $thisDir } ) && $data{ "S" }{ $thisDir } eq "0" ) {
 236         $colors{ "S" } .= color( 'blue' );
 237     } else {
 238         $colors{ "S" } .= color( 'reverse blue' );
 239     }
 240
 241     if ( !defined( $data{ "T" }{ $thisDir } ) || $data{ "T" }{ $thisDir } eq "" || $segFault{ $thisDir } ) {
 242         $colors{ "T" } .= color( 'reverse red' );
 243     }
 244
 245     printf( "%*s ", $noDigits, $testNo );
 246
 247     foreach ( @rowHeaders ) {
 248         my $thisData = $data{ $_ }{ $thisDir };
 249         my $dataLength = length( $thisData );
 250         my $spaceLength = $maxLen{ $_ }-$dataLength;
 251
 252         printf(
 253             $format{ $_ }.$separator{ $_ },
 254             $colors{ $_ }, $dataLength, $thisData,
 255             color( 'reset' ), $spaceLength, "" );
 256     }
 257
 258     foreach ( @rowData ) {
 259         my $thisData = $data{ $_ }{ $thisDir };
 260         my $dataLength = length( $thisData );
 261         my $spaceLength = $maxLen{ $_ }-$dataLength;
 262
 263         printf(
 264             $format{ $_ }.$separator{ $_ },
 265             $spaceLength, "",
 266             $colors{ $_ }, $dataLength, $thisData,
 267             color( 'reset' ) );
 268     }
 269
 270     printf( $headerColor."\n" );
 271
 272     $testNo++;
 273 }
 274
 275 print '-'x$headerLen, "\n";
 276 print( "Tests with zero fails/skips : $testsPassed\n" );
 277 print( "Tests needing further work  : $testsNeedWork\n" );
 278
 279 printf( "Elapsed time : %d seconds\n", time() - $startTime );
 280
 281 sub setMaxLen
 282 {
 283     my ( $test, $length ) = @_;
 284
 285     $maxLen{ $test } = $length if ( defined( $maxLen{ $test} ) && $length > $maxLen{ $test } );
 286 }
 287
 288 sub byCol
 289 {
 290     my $retVal = 0;
 291
 292     my $localA = $a;
 293     my $localB = $b;
 294
 295     if ( $reverseSort ) {
 296         my $tmp = $localA;
 297         $localA = $localB;
 298         $localB = $tmp;
 299     }
 300
 301     if ( $sortIsNumeric ) {
 302         # numeric comparison
 303         $retVal = $data{ $sortCol }{ $localA } <=> $data{ $sortCol }{ $localB };
 304     } else {
 305         # string comparison
 306         $retVal = $data{ $sortCol }{ $localA } cmp $data{ $sortCol }{ $localB };
 307     }
 308
 309     return $retVal;
 310 }