test/errcheck.pl

   1 #!/usr/bin/perl
   2 use strict;
   3
   4 # errcheck.pl
   5 # Check test output for errors.
   6 # usage: test.out | errcheck.pl test [stderr-file]
   7
   8 my $testname = shift || die;
   9 my $errfile = shift || "$testname.expected-stderr";
  10
  11 my @input;
  12 my @original_input;
  13 while (my $line = <>) {
  14     chomp $line;
  15     push @input, $line;
  16     push @original_input, $line;
  17 }
  18
  19 # Run result-checking passes, reducing @input each time
  20 my $xit = 0;
  21 my $bad = "";
  22 $bad |= filter_valgrind() if ($ENV{VALGRIND});
  23 $bad = filter_expected() if ($bad eq ""  &&  -e $errfile);
  24 $bad = filter_bad()  if ($bad eq "");
  25
  26 # OK line should be the only one left
  27 $bad = "(output not 'OK: $testname')" if ($bad eq ""  &&  (scalar(@input) != 1  ||  $input[0] !~ /^OK: $testname/));
  28
  29 if ($bad ne "") {
  30     my $red = "\e[41;37m";
  31     my $def = "\e[0m";
  32     $xit = 1;
  33     print "${red}BAD: /// test '$testname' \\\\\\$def\n";
  34     for my $line (@original_input) {
  35         print "$red $def$line\n";
  36     }
  37     print "${red}BAD: \\\\\\ test '$testname' ///$def\n";
  38     print "${red}FAIL: ## $testname: $bad$def\n";
  39 } else {
  40     print "PASS: $testname\n";
  41 }
  42
  43 exit $xit;
  44
  45 sub filter_expected
  46 {
  47     my $bad = "";
  48
  49     open(my $checkfile, $errfile)
  50         || die "can't find $errfile\n";
  51     my $check = join('', <$checkfile>);
  52     close($checkfile);
  53
  54     my $input = join("\n", @input) . "\n";
  55     if ($input !~ /^$check$/s) {
  56         $bad = "(didn't match $errfile)";
  57         @input = "BAD: $testname";
  58     } else {
  59         @input = "OK: $testname";  # pacify later filter
  60     }
  61
  62     return $bad;
  63 }
  64
  65 sub filter_bad
  66 {
  67     my $bad = "";
  68
  69     my @new_input;
  70     for my $line (@input) {
  71         chomp $line;
  72         if ($line =~ /^BAD: (.*)/) {
  73             $bad = "(failed)";
  74         } else {
  75             push @new_input, $line;
  76         }
  77     }
  78     @input = @new_input;
  79     return $bad;
  80 }
  81
  82 sub filter_valgrind
  83 {
  84     my $errors = 0;
  85     my $leaks = 0;
  86
  87     my @new_input;
  88     for my $line (@input) {
  89         if ($line =~ /^Approx: do_origins_Dirty\([RW]\): missed \d bytes$/) {
  90             # --track-origins warning (harmless)
  91             next;
  92         }
  93         if ($line !~ /^^\.*==\d+==/) {
  94             # not valgrind output
  95             push @new_input, $line;
  96             next;
  97         }
  98
  99         my ($errcount) = ($line =~ /==\d+== ERROR SUMMARY: (\d+) errors/);
 100         if (defined $errcount  &&  $errcount > 0) {
 101             $errors = 1;
 102         }
 103
 104         (my $leakcount) = ($line =~ /==\d+==\s+(?:definitely|possibly) lost:\s+([0-9,]+)/);
 105         if (defined $leakcount  &&  $leakcount > 0) {
 106             $leaks = 1;
 107         }
 108     }
 109
 110     @input = @new_input;
 111
 112     my $bad = "";
 113     $bad .= "(valgrind errors)" if ($errors);
 114     $bad .= "(valgrind leaks)" if ($leaks);
 115     return $bad;
 116 }