unit-tests/bin/result-filter.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Data::Dumper;
   5 use File::Find;
   6 use Cwd;
   7
   8 $Data::Dumper::Terse = 1;
   9
  10 my $root = undef;
  11 my $entry = '';
  12 my $pass_count = 0;
  13 my $total_count = 0;
  14
  15 # first match "root: "
  16
  17 # a line starting with "cwd:" marks the beginning of a new test case
  18 # call process_entry() on each test case
  19 while(<>)
  20 {
  21     if(m/^root:\s+(.*?)$/)
  22     {
  23         $root = $1;
  24     }
  25     elsif(m/^cwd:\s+(.*?)$/)
  26     {
  27         if(length($entry))
  28         {
  29             &process_entry($root, $entry);
  30             $entry = '';
  31         }
  32         $entry .= $_;
  33     }
  34     else
  35     {
  36         $entry .= $_;
  37     }
  38 }
  39 # don't forget last test case (no cwd: to mark end)
  40 if(length($entry))
  41 {
  42     &process_entry($root, $entry);
  43 }
  44
  45 # show totals
  46 my $percentage = $pass_count * 100 / $total_count;
  47 print "\n";
  48 printf " * * * %d of %d unit-tests passed (%.1f percent) * * *\n", $pass_count, $total_count, $percentage;
  49
  50
  51 sub process_entry
  52 {
  53     my ($root, $lines) = @_;
  54
  55     # build an associative array of keys to value(s)
  56     my $lines_seq = [split /\n/, $lines];
  57     #print Dumper($lines_seq);
  58     my $tbl = { 'root' => $root, 'stdout' => [], 'stderr' => [] };
  59     my $line;
  60     foreach $line (@$lines_seq)
  61     {
  62         if($line =~ m/^(\w+):\s+(.*)$/)
  63         {
  64             my $key = $1;
  65             my $val = $2;
  66             if(!exists($$tbl{$key}))
  67             { $$tbl{$key} = ''; }
  68
  69             if($key eq 'stdout' || $key eq 'stderr') # if type is @array
  70             {
  71                 push @{$$tbl{$key}}, $val;
  72             }
  73             else
  74             {
  75                 $$tbl{$key} .= $val;
  76             }
  77         }
  78         else
  79         {
  80             print "ERROR: $line";
  81         }
  82     }
  83     #print Dumper($tbl);
  84     #return;
  85
  86     my $test_name = $$tbl{cwd};
  87     if ($test_name =~ m|.*/([a-zA-Z0-9-+_]+)$|)
  88     {
  89         $test_name = $1;
  90     }
  91
  92     #if make failed (exit was non-zero), mark this as a failure
  93     if(0 ne $$tbl{exit})
  94     {
  95         printf "%-40s FAIL Makefile failure\n", $test_name;
  96         $total_count++;
  97         return;
  98     }
  99     my $seen_result = 0;
 100
 101     # scan all stdout looking for lines that start with PASS or FAIL
 102     foreach $line (@{$$tbl{stdout}})
 103     {
 104         if($line =~ m/^(PASS|XPASS|FAIL|XFAIL).+/)
 105         {
 106             printf "%-40s %s\n", $test_name, $line;
 107             $total_count++;
 108             if($line =~ m/^PASS.+/)
 109             {
 110                 $pass_count++;
 111             }
 112             $seen_result = 1;
 113         }
 114     }
 115     if(!$seen_result)
 116     {
 117         printf "%-40s AMBIGIOUS missing [X]PASS/[X]FAIL\n", $test_name;
 118         $total_count++;
 119     }
 120 }