1#! /usr/bin/perl
2
3# Post-processor for compiler output to filter out warnings matched in
4# support-files/compiler_warnings.supp. This makes it easier to check
5# that no new warnings are introduced without needing to submit a build
6# for Buildbot.
7#
8# Use by setting CC="ccfilter gcc" CXX="ccfilter gcc" before ./configure.
9#
10# When testing from command line, you can run it as
11# perl ccfilter cat logfile > /dev/null
12# to see the errors that are not filtered
13#
14# By default, just filters the output for suppressed warnings. If the
15# FAILONWARNING environment variable is set, then instead will fail the
16# compile on encountering a non-suppressed warnings.
17
18
19use strict;
20use warnings;
21
22my $suppressions;
23my $filter_stderr= $ARGV[0] ne "cat";
24
25open STDOUT_COPY, ">&STDOUT"
26    or die "Failed to dup stdout: $!]n";
27
28my $pid= open(PIPE, '-|');
29
30if (!defined($pid)) {
31  die "Error: Cannot fork(): $!\n";
32} elsif (!$pid) {
33  # Child.
34  # actually want to send the STDERR to the parent, not the STDOUT.
35  # So shuffle things around a bit.
36  if ($filter_stderr)
37  {
38    open STDERR, ">&STDOUT"
39        or die "Child: Failed to dup pipe to parent: $!\n";
40    open STDOUT, ">&STDOUT_COPY"
41        or die "Child: Failed to dup parent stdout: $!\n";
42    close STDOUT_COPY;
43  }
44  exec { $ARGV[0] } @ARGV;
45  die "Child: exec() failed: $!\n";
46} else {
47  # Parent.
48  close STDOUT_COPY;
49  my $cwd= qx(pwd);
50  chomp($cwd);
51  while (<PIPE>) {
52    my $line= $_;
53    if (/^(.*?):([0-9]+):(?:[0-9]+:)? [Ww]arning: (.*)$/) {
54      my ($file, $lineno, $msg)= ($1, $2, $3);
55      $file= "$cwd/$file" if (length($file) > 0 && substr($file,0,1) ne "/");
56
57      next
58          if check_if_suppressed($file, $lineno, $msg);
59      die "$line\nGot warning, terminating.\n"
60          if $ENV{FAILONWARNING};
61      print STDERR $line;
62      next;
63    }
64    if ($filter_stderr)
65    {
66      print STDERR $line;
67    }
68    else
69    {
70      print STDOUT $line;
71    }
72  }
73  close(PIPE);
74}
75
76exit 0;
77
78sub check_if_suppressed {
79  my ($file, $lineno, $msg)= @_;
80  load_suppressions() unless defined($suppressions);
81  for my $s (@$suppressions) {
82    my ($file_re, $msg_re, $start, $end)= @$s;
83    if ($file =~ /$file_re/ &&
84        $msg =~ /$msg_re/ &&
85        (!defined($start) || $start <= $lineno) &&
86        (!defined($end) || $end >= $lineno)) {
87      return 1;
88    }
89  }
90  return undef;
91}
92
93sub load_suppressions {
94  # First find the suppressions file, might be we need to move up to
95  # the base directory.
96  my $path = "support-files/compiler_warnings.supp";
97  my $exists;
98  for (1..10) {
99    $exists= -f $path;
100    last if $exists;
101    $path= '../'. $path;
102  }
103  die "Error: Could not find suppression file (out of source dir?).\n"
104      unless $exists;
105
106  $suppressions= [];
107  open "F", "<", $path
108      or die "Error: Could not read suppression file '$path': $!\n";
109  while (<F>) {
110    # Skip comment and empty lines.
111    next if /^\s*(\#.*)?$/;
112    die "Invalid syntax in suppression file '$path', line $.:\n$_"
113        unless /^\s*(.+?)\s*:\s*(.+?)\s*(?:[:]\s*([0-9]+)(?:-([0-9]+))?\s*)?$/;
114    my ($file_re, $line_re, $start, $end)= ($1, $2, $3, $4);
115    $end = $start
116        if defined($start) && !defined($end);
117    push @$suppressions, [$file_re, $line_re, $start, $end];
118  }
119}
120