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