X-Git-Url: https://vcs.maemo.org/git/?a=blobdiff_plain;f=zouba%2Ftests%2FtestSummary;fp=zouba%2Ftests%2FtestSummary;h=0000000000000000000000000000000000000000;hb=15842000c65c6c7529d0fe35e13253adb4293afd;hp=3766d939a53a3dd51d86397a8d00628902f81925;hpb=5789808b3e0c9a6a1d779270ecfbf0854f4d1b1e;p=ptas diff --git a/zouba/tests/testSummary b/zouba/tests/testSummary deleted file mode 100755 index 3766d93..0000000 --- a/zouba/tests/testSummary +++ /dev/null @@ -1,310 +0,0 @@ -#! /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 use 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, ; - push @allDirs, ; - 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 () { - 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; -}