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 printf " * * * %d of %d unit-tests passed (%.1f percent) * * *\n", $pass_count, $total_count, $percentage;
  48
  49
  50 sub process_entry
  51 {
  52     my ($root, $lines) = @_;
  53
  54     # build an associative array of keys to value(s)
  55     my $lines_seq = [split /\n/, $lines];
  56     #print Dumper($lines_seq);
  57     my $tbl = { 'root' => $root, 'stdout' => [], 'stderr' => [] };
  58     my $line;
  59     foreach $line (@$lines_seq)
  60     {
  61         if($line =~ m/^(\w+):\s+(.*)$/)
  62         {
  63             my $key = $1;
  64             my $val = $2;
  65             if(!exists($$tbl{$key}))
  66             { $$tbl{$key} = ''; }
  67
  68             if($key eq 'stdout' || $key eq 'stderr') # if type is @array
  69             {
  70                 push @{$$tbl{$key}}, $val;
  71             }
  72             else
  73             {
  74                 $$tbl{$key} .= $val;
  75             }
  76         }
  77         else
  78         {
  79             print "ERROR: $line";
  80         }
  81     }
  82     #print Dumper($tbl);
  83     #return;
  84
  85     my $test_name = $$tbl{cwd};
  86     if ($test_name =~ m|.*/([a-zA-Z0-9-+_]+)$|)
  87     {
  88         $test_name = $1;
  89     }
  90
  91     #if make failed (exit was non-zero), mark this as a failure
  92     if(0 ne $$tbl{exit})
  93     {
  94         printf "%-40s FAIL Makefile failure\n", $test_name;
  95         $total_count++;
  96         return;
  97     }
  98
  99     #if there was any output to stderr, mark this as a failure
 100     foreach $line (@{$$tbl{stderr}})
 101     {
 102         printf "%-40s FAIL spurious stderr failure: %s\n", $test_name, $line;
 103         $total_count++;
 104         return;
 105     }
 106
 107     # scan all stdout looking for lines that start with PASS or FAIL
 108     my $seen_result = 0;
 109     foreach $line (@{$$tbl{stdout}})
 110     {
 111         if($line =~ m/^(PASS|XPASS|FAIL|XFAIL).+/)
 112         {
 113             printf "%-40s %s\n", $test_name, $line;
 114             $total_count++;
 115             if($line =~ m/^PASS.+/)
 116             {
 117                 $pass_count++;
 118             }
 119             $seen_result = 1;
 120         }
 121     }
 122     if(!$seen_result)
 123     {
 124         printf "%-40s AMBIGIOUS missing [X]PASS/[X]FAIL\n", $test_name;
 125         $total_count++;
 126     }
 127 }