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