2019-11-14 03:04:26 +08:00
#!/usr/bin/env perl
2019-06-18 04:35:08 +08:00
require 5.003;
2019-11-14 03:04:26 +08:00
use warnings;
2019-06-18 04:35:08 +08:00
#
# Copyright by The HDF Group.
# All rights reserved.
#
# This file is part of HDF5. The full HDF5 copyright notice, including
# terms governing use, modification, and redistribution, is contained in
2022-11-02 05:02:27 +08:00
# the COPYING file, which can be found at the root of the source code
# distribution tree, or in https://www.hdfgroup.org/licenses.
# If you do not have access to either file, you may request a copy from
# help@hdfgroup.org.
2019-06-18 04:35:08 +08:00
#
# Purpose: Given an input file containing the output from a build of the
# library, gather the file names and line numbers, alias
# identical types of warnings together into a single bin and
# report the number of warnings for each type of warning, each file
# and the total count of warnings
# Perl modules/settings
use strict;
use Getopt::Std;
2023-12-29 22:42:35 +08:00
use File::Find;
use File::Basename;
use Cwd;
#use Data::Dumper;
2019-06-18 04:35:08 +08:00
# Global variables, for accumulating information
2023-12-29 22:42:35 +08:00
my %options=();
2019-06-18 04:35:08 +08:00
my $totalcount = 0;
2020-12-22 02:57:18 +08:00
my $notecount = 0;
my $dupcount = 0;
2019-06-18 04:35:08 +08:00
my %warn_count = ();
my $warncount;
my %warn_file = ();
my %warn_file_line = ();
2020-12-22 02:57:18 +08:00
my %warn_file_line_offset = ();
2019-06-18 04:35:08 +08:00
my %file_count = ();
my $filecount;
my $ignorecount = 0;
my @ignorenames;
my %ignored_files = ();
my %warn_file_indices = ();
my %file_warn_indices = ();
2019-07-03 12:43:45 +08:00
my @warn_match_strings;
my @file_match_strings;
2019-06-18 04:35:08 +08:00
my %file_warn = ();
my %file_warn_line = ();
my $current_warning = 0;
my $current_file = 0;
my $warn_index;
2020-12-22 02:57:18 +08:00
my $genericize = 1;
# Info about last name / line / offset for file
2019-06-18 04:35:08 +08:00
my $last_c_name;
my $last_fort_name;
my $last_fort_line;
2020-12-22 02:57:18 +08:00
my $last_fort_offset;
2019-06-18 04:35:08 +08:00
2023-12-29 22:42:35 +08:00
# Info about source files
my %c_files;
my %c_files_counted;
my %cpp_files;
my %cpp_files_counted;
my %fort_files;
my %fort_files_counted;
my $c_lines = 0;
my $cpp_lines = 0;
my $fort_lines = 0;
2019-07-03 12:43:45 +08:00
# Display usage
sub do_help {
2023-12-29 22:42:35 +08:00
print "Usage: 'warnhist [-h, --help] [-t <prefix>] [-w <n>] [-W] [-f <n>] [-F]\n";
print "\t[-s <warning string list>] [-S <file string list] [-l] [-u]'\n";
print "\t[-i <name list>] [-d] [-p <path list] [-q] [file]'\n\n";
print "Options:\n";
print "\t-h, --help Display this usage\n";
print "\t-t <prefix> Trim pathname prefix from filenames, <prefix>\n";
2019-06-18 04:35:08 +08:00
print "\t-w <n>\tDisplay files for a given warning index list, <n>\n";
print "\t\t<n> can be a single value, a range, or a comma separated list\n";
print "\t\tFor example: '0' or '0,4' or '8-10' or '0,2-4,8-10,13'\n";
print "\t-W\tDisplay files for all warnings\n";
print "\t-f <n>\tDisplay warnings for a given file index list, <n>\n";
print "\t\t<n> can be a single value, a range, or a comma separated list\n";
print "\t\tFor example: '0' or '0,4' or '8-10' or '0,2-4,8-10,13'\n";
print "\t-F\tDisplay warnings for all files\n";
2023-12-29 22:42:35 +08:00
print "\t-s <warning string list> Display files for warnings which contain a\n";
print "\t\tstring, <warning string list>\n";
2019-07-03 12:43:45 +08:00
print "\t\t<warning string list> is a comma separated list, with no spaces\n";
2023-12-29 22:42:35 +08:00
print "\t\tFor example: 'Wunused-dummy-argument' or\n";
print "\t\t'Wunused-dummy-argument,Wunused-variable'\n";
print "\t-S <file string list> Display warnings for files which contain a\n";
print "\t\tstring, <file string list>\n";
2019-07-03 12:43:45 +08:00
print "\t\t<file string list> is a comma separated list, with no spaces\n";
print "\t\tFor example: 'H5Fint' or 'H5Fint,H5Gnode'\n";
2021-12-07 22:27:29 +08:00
print "\t-l\tDisplay line numbers for file/warning\n";
2019-07-06 02:31:38 +08:00
print "\t-u\tLeave 'unique' types in warnings, instead of genericizing them\n";
2019-06-18 04:35:08 +08:00
print "\t-i <name list>\tIgnore named files, <name list>\n";
print "\t\t<name list> is a comma separated list, with no spaces\n";
print "\t\tFor example: 'H5LTparse' or 'H5LTparse,H5LTanalyze'\n";
2023-12-29 22:42:35 +08:00
print "\t-d\tCompute warning density for compiled source files. Paths to the\n";
print "\t\troot of a directory containing source may be provided with the\n";
print "\t\t'-p <path list>' option. If the path list is given, only those\n";
print "\t\tdirectories are scanned for source files. If the path list\n";
print "\t\toption is not given, the current working directory is scanned.\n";
print "\t-p <path list>\tPaths to search for compiled files. Compiled files\n";
print "\t\tare only used when computing warning density and are not\n";
print "\t\tnecessary for just analyzing warnings in build output.\n";
print "\t\t<path list> is a comma separated list, with no spaces\n";
print "\t\tFor example: '/home/koziol/hdf5' or '.,~/dev/hdf5,~/dev/build'\n";
print "\t-q\tSuppress warning output\n";
2019-06-18 04:35:08 +08:00
print "\tfile\tFilename containing build output\n";
print "\t\tIf no file is given, standard input is used.\n";
exit;
}
2023-12-29 22:42:35 +08:00
# Count # of lines in a file
sub line_count {
my ($name) = @_;
#print "name = '$name'\n";
my $tmp;
my $lines = 0;
open (FILE, $name) or die "Can't open '$name': $!";
$lines++ while ($tmp = <FILE>);
close FILE;
#print "$lines\n";
return $lines;
}
# Recursively search a directory hierarchy for source files
# Adds results to the global %c_files, %cpp_files, and %fort_files hashes
sub parse_tree {
my ($root_path) = @_;
#print "root_path = $root_path\n";
my $path_checker = sub {
my $name = $File::Find::name;
if (-f $name) {
my $bn = basename($name);
# Check for different kinds of source files
# Use lists here: https://gist.github.com/ppisarczyk/43962d06686722d26d176fad46879d41#file-programming_languages_extensions-json
# FORTRAN source file
if($bn =~ /.*(\.f90)|(\.f)|(\.f03)|(\.f08)|(\.f77)|(\.f95)|(\.for)|(\.fpp)$/i) {
$bn =~ s/(\.f90)|(\.f)|(\.f03)|(\.f08)|(\.f77)|(\.f95)|(\.for)|(\.fpp)$//ig;
if(!exists $fort_files{$bn}) {
$fort_files{$bn} = [ $name ];
} else {
push @{ $fort_files{$bn} }, $name;
}
# C++ source file
} elsif($bn =~ /.*(\.cpp)|(\.c\+\+)|(\.cc)|(\.cp)|(\.cxx)$/i) {
$bn =~ s/(\.cpp)|(\.c\+\+)|(\.cc)|(\.cp)|(\.cxx)$//ig;
if(!exists $cpp_files{$bn}) {
$cpp_files{$bn} = [ $name ];
} else {
push @{ $cpp_files{$bn} }, $name;
}
# C source file
} elsif($bn =~ /.*(\.c)$/i) {
$bn =~ s/(\.c)$//g;
if(!exists $c_files{$bn}) {
$c_files{$bn} = [ $name ];
} else {
push @{ $c_files{$bn} }, $name;
}
}
}
};
find($path_checker, $root_path);
#print Dumper \%c_files;
#print Dumper \%cpp_files;
#print Dumper \%fort_files;
}
sub count_file_loc {
my ($filename, $typename, $file_paths, $files_counted, $count) = @_;
# Attempt to detect and handle object file name mangling by Automake
if(!exists $file_paths->{$filename} && $filename =~ /\-/) {
my ($bn) = $filename =~ /\S+\-(\S+)$/x;
if(exists $file_paths->{$bn}) {
if(!exists $options{q}) {
warn "No path for $typename source file '$filename', but '$bn' has path, assuming automake generated object file name";
}
$filename = $bn;
}
}
if(exists $file_paths->{$filename}) {
my $filecount = 0;
# Attempt to count LOC for files with same name
if(scalar(@{$file_paths->{$filename}}) > 1) {
$filecount = $files_counted->{$filename}++;
# Issue warning about multiple source files with same name
if($filecount == 0 && !exists $options{q}) {
local $" = ', '; # '$"' is documented in https://perldoc.perl.org/perlvar
warn "Multiple paths for $typename source file named '$filename', assuming each is compiled once, paths: [@{$file_paths->{$filename}}]\n";
}
# Sanity check for too many compiles of a file
if($filecount >= scalar(@{$file_paths->{$filename}})) {
if(!exists $options{q}) {
local $" = ', '; # '$"' is documented in https://perldoc.perl.org/perlvar
warn "Too many compiles of $typename source file named '$filename' with paths: [@{$file_paths->{$filename}}], disabling warning density calculations\n";
}
delete $options{d};
}
}
# Increment the # of lines of code (if not too many)
if($filecount < scalar(@{$file_paths->{$filename}})) {
${$count} += line_count($file_paths->{$filename}[$filecount]);
}
} else {
if(!exists $options{q}) {
warn "No path for $typename source file '$filename', e '-p' option to specify, disabling warning density calculations\n";
}
delete $options{d};
}
}
# Compute LOC for compiled source file
sub count_source_loc {
my ($compile_line) = @_;
#print "compile_line = $compile_line\n";
my $filetype;
my $filename;
($filetype, $filename) = $compile_line =~ /^\s+(CC|FC|CXX|PPFC)\s+(\S*)\.l*o$/x;
if($filename =~ /\//) {
$filename = basename($filename);
}
#print "filetype = '$filetype'\n";
#print "filename = '$filename'\n";
if($filetype =~ /FC|PPFC/) { # FORTRAN source file
count_file_loc($filename, "FORTRAN", \%fort_files, \%fort_files_counted, \$fort_lines);
} elsif($filetype =~ /CXX/) { # C++ source file
count_file_loc($filename, "C++", \%cpp_files, \%cpp_files_counted, \$cpp_lines);
} elsif($filetype =~ /CC/) { # C source file
count_file_loc($filename, "C", \%c_files, \%c_files_counted, \$c_lines);
}
}
sub sanity_check_loc {
my ($typename, $file_paths, $files_counted) = @_;
if(scalar keys %{$files_counted} > 0) {
for my $x (keys(%{$files_counted})) {
#print "x = $x, # of compiles = ${$files_counted}{$x}, # of paths = ", scalar(@{$file_paths->{$x}}), "\n";
if($files_counted->{$x} != scalar(@{$file_paths->{$x}})) {
if(!exists $options{q}) {
warn "# of compiles of C source file '$x' ($files_counted->{$x}) != # of paths (", scalar(@{$file_paths->{$x}}), "), disabling warning density calculation\n";
}
# Don't print warning density, it's not accurate
delete $options{d};
last;
}
}
}
}
2019-07-03 12:43:45 +08:00
sub main::HELP_MESSAGE {
do_help();
}
# declare the Perl command line flags/options we want to allow
2023-12-29 22:42:35 +08:00
getopts("FWhut:w:f:s:S:i:ldp:q", \%options);
2019-07-03 12:43:45 +08:00
# Display usage, if requested
if($options{h}) {
do_help();
}
2019-06-18 04:35:08 +08:00
# Parse list of file names to ignore
if(exists $options{i}) {
@ignorenames = split /,/, $options{i};
2020-12-22 02:57:18 +08:00
#print STDERR @ignorenames;
2019-06-18 04:35:08 +08:00
}
# Parse list of warning indices to expand file names
if(exists $options{w}) {
my @tmp_indices;
@tmp_indices = split /,/, $options{w};
2020-12-22 02:57:18 +08:00
#print STDERR @tmp_indices;
2019-06-18 04:35:08 +08:00
for my $x (@tmp_indices) {
2020-12-22 02:57:18 +08:00
#print STDERR "x = '$x'\n";
2019-06-18 04:35:08 +08:00
if($x =~ /\-/) {
my $start_index;
my $end_index;
2020-12-22 02:57:18 +08:00
#print STDERR "matched = '$x'\n";
2019-06-18 04:35:08 +08:00
($start_index, $end_index) = split /\-/, $x;
2020-12-22 02:57:18 +08:00
#print STDERR "start_index = '$start_index', end_index = '$end_index'\n";
2019-06-18 04:35:08 +08:00
for my $y ($start_index..$end_index) {
2020-12-22 02:57:18 +08:00
#print STDERR "y = '$y'\n";
2019-07-03 12:43:45 +08:00
if(!exists $warn_file_indices{$y}) {
2019-06-18 04:35:08 +08:00
$warn_file_indices{$y} = $y;
}
}
}
else {
2019-07-03 12:43:45 +08:00
if(!exists $warn_file_indices{$x}) {
2019-06-18 04:35:08 +08:00
$warn_file_indices{$x} = $x;
}
}
}
#foreach (sort keys %warn_file_indices) {
2020-12-22 02:57:18 +08:00
# print STDERR "$_ : $warn_file_indices{$_}\n";
2019-06-18 04:35:08 +08:00
#}
}
2019-07-03 12:43:45 +08:00
# Parse list of warning strings to expand file names
if(exists $options{s}) {
@warn_match_strings = split /,/, $options{s};
2020-12-22 02:57:18 +08:00
# print STDERR @warn_match_strings;
2019-07-03 12:43:45 +08:00
}
2019-06-18 04:35:08 +08:00
# Parse list of file indices to expand warnings
if(exists $options{f}) {
my @tmp_indices;
@tmp_indices = split /,/, $options{f};
2020-12-22 02:57:18 +08:00
#print STDERR @tmp_indices;
2019-06-18 04:35:08 +08:00
for my $x (@tmp_indices) {
2020-12-22 02:57:18 +08:00
#print STDERR "x = '$x'\n";
2019-06-18 04:35:08 +08:00
if($x =~ /\-/) {
my $start_index;
my $end_index;
2020-12-22 02:57:18 +08:00
#print STDERR "matched = '$x'\n";
2019-06-18 04:35:08 +08:00
($start_index, $end_index) = split /\-/, $x;
2020-12-22 02:57:18 +08:00
#print STDERR "start_index = '$start_index', end_index = '$end_index'\n";
2019-06-18 04:35:08 +08:00
for my $y ($start_index..$end_index) {
2020-12-22 02:57:18 +08:00
#print STDERR "y = '$y'\n";
2019-07-03 12:43:45 +08:00
if(!exists $file_warn_indices{$y}) {
2019-06-18 04:35:08 +08:00
$file_warn_indices{$y} = $y;
}
}
}
else {
2019-07-03 12:43:45 +08:00
if(!exists $file_warn_indices{$x}) {
2019-06-18 04:35:08 +08:00
$file_warn_indices{$x} = $x;
}
}
}
#foreach (sort keys %warn_file_indices) {
2020-12-22 02:57:18 +08:00
# print STDERR "$_ : $warn_file_indices{$_}\n";
2019-06-18 04:35:08 +08:00
#}
}
2019-07-03 12:43:45 +08:00
# Parse list of warning strings for files to expand warnings
if(exists $options{S}) {
@file_match_strings = split /,/, $options{S};
2020-12-22 02:57:18 +08:00
# print STDERR @file_match_strings;
2019-07-03 12:43:45 +08:00
}
2019-07-06 02:31:38 +08:00
# Check if warnings should stay unique and not be "genericized"
if($options{u}) {
$genericize = 0;
}
2023-12-29 22:42:35 +08:00
# Scan source files, if warning density requested
if(exists $options{d}) {
if(exists $options{p}) {
my @pathnames = split /,/, $options{p};
#print STDERR @pathnames;
for my $path (@pathnames) {
parse_tree($path);
}
} else {
# Scan the current working directory
parse_tree(getcwd);
}
}
2019-06-18 04:35:08 +08:00
PARSE_LINES:
while (<>) {
my $name;
my $line;
my $prev_line;
my $toss;
my $offset;
my $warning;
2019-06-21 23:05:34 +08:00
my $extra;
2019-06-28 22:10:43 +08:00
my $extra2;
2019-06-18 04:35:08 +08:00
# Retain last FORTRAN compile line, which comes a few lines before warning
2023-12-29 22:42:35 +08:00
if($_ =~ /.*((\.inc)|(\.f90)|(\.f)|(\.f03)|(\.f08)|(\.f77)|(\.f95)|(\.for)|(\.fpp))\:.*/i) {
2020-12-22 02:57:18 +08:00
($last_fort_name, $last_fort_line, $last_fort_offset) = split /\:/, $_;
2019-06-18 04:35:08 +08:00
($last_fort_line, $toss) = split /\./, $last_fort_line;
}
2019-07-03 12:43:45 +08:00
# Retain last C/C++ compile line, which possibly comes a few lines before warning
if($_ =~ /.*[A-Za-z0-9_]\.[cC]:.*/) {
2019-06-18 04:35:08 +08:00
($last_c_name, $toss) = split /\:/, $_;
}
2019-12-04 10:52:55 +08:00
# Retain C/C++ compile line, which comes with the line of warning
if($_ =~ /.*[A-Za-z0-9_]\.[chC]\(.*[0-9]\):.*#.*/) {
$last_c_name = $_;
}
2023-12-29 22:42:35 +08:00
# Compute LOC for compiled source files, if warning density requested
if(exists $options{d}) {
# Check for compilation line
if($_ =~ /^\s+(CC|FC|CXX|PPFC)\s+/) {
count_source_loc($_);
}
}
2019-06-28 22:10:43 +08:00
# Skip lines that don't have the word "warning"
2019-12-04 10:52:55 +08:00
next if $_ !~ /[Ww]arning/;
2019-06-18 04:35:08 +08:00
# Skip warnings from linker
next if $_ =~ /ld: warning:/;
2023-12-29 22:42:35 +08:00
# Skip warnings from make
next if $_ =~ /^Makefile:[\d]*: warning:/;
2020-12-22 02:57:18 +08:00
# Skip warnings from build_py and install_lib
2019-07-03 12:43:45 +08:00
next if $_ =~ /warning: (build_py|install_lib)/;
2023-12-29 22:42:35 +08:00
# Skip variables with the word 'warning' (case insensitively) in them
next if $_ =~ /_warning_/i;
next if $_ =~ /_warning/i;
next if $_ =~ /warning_/i;
2020-12-22 02:57:18 +08:00
2022-05-03 08:22:07 +08:00
# Skip AMD Optimizing Compiler (aocc) lines "<#> warning(s) generated."
next if $_ =~ / warnings? generated\./;
2019-06-28 22:10:43 +08:00
# "Hide" the C++ '::' symbol until we've parsed out the parts of the line
while($_ =~ /\:\:/) {
$_ =~ s/\:\:/@@@@/g;
}
2019-06-18 04:35:08 +08:00
# Check for weird formatting of warning message
2020-12-22 02:57:18 +08:00
$line = "??";
$offset = "??";
2023-12-29 22:42:35 +08:00
if($_ =~ /^(cc1|<command-line>): warning:.*/) {
2019-06-18 04:35:08 +08:00
$name = $last_c_name;
2019-06-28 22:10:43 +08:00
($toss, $toss, $warning, $extra, $extra2) = split /\:/, $_;
2022-08-19 22:09:59 +08:00
# Check for file-scope gcc Fortran warning output
} elsif($_ =~ /f\d\d\d: Warning:/) {
# These are interspersed with the "compiling a file" output
# when compiling with `make -j` and thus difficult to tie to
# any particular file. They are due to things like inappropriate
# build options and don't have a line number.
#
# They start with f, as in f951
$name = "(generic)";
$line = int(rand(1000000)); # Hack to avoid counting as duplictates
($warning) = $_ =~ /\[(.*)\]/x;
2019-06-18 04:35:08 +08:00
# Check for FORTRAN warning output
} elsif($_ =~ /^Warning:.*/) {
$name = $last_fort_name;
$line = $last_fort_line;
2020-12-22 02:57:18 +08:00
$offset = $last_fort_offset;
2019-06-28 22:10:43 +08:00
($toss, $warning, $extra, $extra2) = split /\:/, $_;
2020-12-22 02:57:18 +08:00
2019-06-18 04:35:08 +08:00
# Check for improperly parsed filename or line
if($name =~ /^$/) {
print "Filename is a null string! Input line #$. is: '$_'";
next
}
if($line =~ /^$/) {
print "Line is a null string! Input line #$. is: '$_'";
next
}
2019-07-10 11:15:36 +08:00
# Check for non-GCC warning (Solaris/Oracle?)
} elsif($_ =~ /^\".*, line [0-9]+: *[Ww]arning:.*/) {
($name, $toss, $warning, $extra, $extra2) = split /\:/, $_;
($name, $line) = split /\,/, $name;
2023-12-29 22:42:35 +08:00
$name =~ s/^\"//g;
$name =~ s/\"$//g;
$line =~ s/^\s*line\s*//g;
2019-12-04 10:52:55 +08:00
# Check for Intel icc warning
} elsif($_ =~ /.*[A-Za-z0-9_]\.[chC]\(.*[0-9]\):.*#.*/) {
($last_c_name, $toss, $warning) = split /\:/, $last_c_name;
($name, $line) = split /\(/, $last_c_name;
$line =~ s/\)//g;
2019-06-18 04:35:08 +08:00
} else {
2019-06-28 22:10:43 +08:00
# Check for 'character offset' field appended to file & line #
2019-07-10 11:15:36 +08:00
# (This is probably specific to GCC)
2019-06-18 04:35:08 +08:00
if($_ =~ /^.*[0-9]+\:[0-9]+\:/) {
2019-06-28 22:10:43 +08:00
($name, $line, $offset, $toss, $warning, $extra, $extra2) = split /\:/, $_;
2019-06-18 04:35:08 +08:00
} else {
2019-06-28 22:10:43 +08:00
($name, $line, $toss, $warning, $extra, $extra2) = split /\:/, $_;
2019-06-18 04:35:08 +08:00
}
}
2019-06-21 23:05:34 +08:00
# Check for extra ':' followed by more text in original warning string,
# and append the ':' and text back onto the parsed warning
2023-12-29 22:42:35 +08:00
if(defined $extra) {
2019-06-21 23:05:34 +08:00
$warning = join ':', $warning, $extra;
}
2023-12-29 22:42:35 +08:00
if(defined $extra2) {
2019-06-28 22:10:43 +08:00
$warning = join ':', $warning, $extra2;
}
2019-06-18 04:35:08 +08:00
# Trim leading '..' paths from filename
while($name =~ /^\.\.\//) {
$name =~ s/^\.\.\///g;
}
# Check for trimming prefix
if((exists $options{t}) && ($name =~ /$options{t}/)) {
$name =~ s/^$options{t}\///g;
}
# Check for ignored file
if(exists $options{i}) {
for my $x (@ignorenames) {
if($name =~ /$x/) {
$ignorecount++;
if(!(exists $ignored_files{$name})) {
$ignored_files{$name} = $name;
}
next PARSE_LINES;
}
}
}
# Check for improperly parsed warning (usually an undefined warning string)
if(!defined $warning) {
print "Warning Undefined! Input line is: '$_'";
next
}
2023-12-29 22:42:35 +08:00
# Restore the C++ '::' symbol now that we've parsed out the parts of the line
while($warning =~ /@@@@/) {
$warning =~ s/@@@@/\:\:/g;
}
2019-06-18 04:35:08 +08:00
# Get rid of leading & trailing whitespace
$warning =~ s/^\s//g;
$warning =~ s/\s$//g;
# Check for improperly parsed warning
if($warning =~ /^$/) {
print "Warning is a null string! Input line is: '$_'";
next
}
# Convert all quotes to '
$warning =~ s/‘ /'/g;
$warning =~ s/’ /'/g;
2019-12-04 10:52:55 +08:00
$warning =~ s/"/'/g;
2019-06-18 04:35:08 +08:00
2019-07-06 02:31:38 +08:00
#
# These skipped messages & "genericizations" may be specific to GCC
2019-06-18 04:35:08 +08:00
# Skip supplemental warning message
2020-12-22 02:57:18 +08:00
if($warning =~ /near initialization for/) {
$notecount++;
next
}
2019-06-18 04:35:08 +08:00
2019-06-28 22:10:43 +08:00
# Skip C++ supplemental warning message
2020-12-22 02:57:18 +08:00
if($warning =~ /in call to/) {
$notecount++;
next
}
2019-06-28 22:10:43 +08:00
2019-06-18 04:35:08 +08:00
# Skip GCC warning that should be a note
2020-12-22 02:57:18 +08:00
if($_ =~ /\(this will be reported only once per input file\)/) {
$notecount++;
next
}
2019-06-18 04:35:08 +08:00
2019-07-06 02:31:38 +08:00
if($genericize) {
# Eliminate C/C++ "{aka <some type>}" and "{aka '<some type>'}" info
if($warning =~ /\s(\{|\()aka '?[A-Za-z_0-9\(\)\*\,\[\]\.\<\>\&\:\+\#]+[A-Za-z_0-9\(\)\*\,\[\]\.\<\>\&\:\+\#\ ]*'?(\}|\))/) {
$warning =~ s/\s(\{|\()aka '?[A-Za-z_0-9\(\)\*\,\[\]\.\<\>\&\:\+\#]+[A-Za-z_0-9\(\)\*\,\[\]\.\<\>\&\:\+\#\ ]*'?(\}|\))//g;
}
2019-06-18 04:35:08 +08:00
2019-07-10 11:15:36 +08:00
# Genericize C/C++ '<some type>', printf format '%<some format>', and
# "unknown warning group" into '-'
if($warning =~ /'[A-Za-z_0-9\(\)\*\,\[\]\.\<\>\&\:\+\#\-\=]+[A-Za-z_0-9\(\)\*\,\[\]\.\<\>\&\:\+\#\-\=\ ]*'/) {
$warning =~ s/'[A-Za-z_0-9\(\)\*\,\[\]\.\<\>\&\:\+\#\-\=]+[A-Za-z_0-9\(\)\*\,\[\]\.\<\>\&\:\+\#\-\=\ ]*'/'-'/g;
2019-07-06 02:31:38 +08:00
}
2023-12-29 22:42:35 +08:00
if($warning =~ /'%[\#0\-\ \+]*[,;\:_]?[0-9\*]*\.?[0-9\*]*[hjltzL]*[aAcdeEfFgGinopsuxX]'/) {
$warning =~ s/'%[\#0\-\ \+]*[,;\:_]?[0-9\*]*\.?[0-9\*]*[hjltzL]*[aAcdeEfFgGinopsuxX]'/'-'/g;
2019-07-06 02:31:38 +08:00
}
# Genericize C/C++ "<macro>" warnings into "-"
if($warning =~ /"[A-Za-z_0-9]*"/) {
$warning =~ s/"[A-Za-z_0-9]*"/"-"/g;
}
2022-08-11 04:57:26 +08:00
# Genericize [GCC?] C/C++ warning text about suggested attribute
2019-07-06 02:31:38 +08:00
if($warning =~ /attribute=[A-Za-z_0-9]*\]/) {
$warning =~ s/=[A-Za-z_0-9]*\]/=-\]/g;
}
2023-12-29 22:42:35 +08:00
# Genericize C/C++ "No such file or directory" warnings into "-"
if($warning =~ /^[A-Za-z_0-9\/]*: No such file or directory/) {
$warning =~ s/^[A-Za-z_0-9\/]*:/'-':/g;
}
2019-07-06 02:31:38 +08:00
# Genericize FORTRAN "at (<n>)" into "at (-)", "REAL(<n>)" into "REAL(-)",
# and "INTEGER(<n>)" into "INTEGER(-)"
if($warning =~ /.*at\s\([0-9]+\).*/) {
$warning =~ s/at\s\([0-9]+\)/at \(-\)/g;
}
if($warning =~ /.*REAL\([0-9]+\).*/) {
$warning =~ s/REAL\([0-9]+\)/REAL\(-\)/g;
}
if($warning =~ /.*INTEGER\([0-9]+\).*/) {
$warning =~ s/INTEGER\([0-9]+\)/INTEGER\(-\)/g;
}
# Genericize standalone numbers in warnings
2019-07-10 11:15:36 +08:00
if($warning =~ /(\s|')-?[0-9]+(\s|')/) {
$warning =~ s/-?[0-9]+/-/g;
2019-07-06 02:31:38 +08:00
}
# Genericize unusual GCC/G++/GFORTRAN warnings that aren't handled above
if($warning =~ /\[deprecation\] [A-Za-z_0-9]*\([A-Za-z_,0-9]*\) in [A-Za-z_0-9]* has been deprecated.*/) {
$warning =~ s/[A-Za-z_0-9]*\([A-Za-z_,0-9]*\) in [A-Za-z_0-9]*/-\(-\) in -/g;
}
2019-06-18 04:35:08 +08:00
}
2019-07-06 02:31:38 +08:00
# <end possible GCC-specific code>
2019-06-18 04:35:08 +08:00
2019-07-03 12:43:45 +08:00
# Check if we've already seen this warning on this line in this file
# (Can happen for warnings from inside header files)
2020-12-22 02:57:18 +08:00
if( !exists $warn_file_line_offset{$warning}{$name}{$line}{$offset} ) {
2019-07-03 12:43:45 +08:00
# Increment count for [generic] warning
$warn_count{$warning}++;
$warn_file{$warning}{$name}++;
$warn_file_line{$warning}{$name}{$line}++;
2020-12-22 02:57:18 +08:00
$warn_file_line_offset{$warning}{$name}{$line}{$offset}++;
2019-07-03 12:43:45 +08:00
# Increment count for filename
$file_count{$name}++;
$file_warn{$name}{$warning}++;
$file_warn_line{$name}{$warning}{$line}++;
# Increment total count of warnings
$totalcount++;
}
2020-12-22 02:57:18 +08:00
else {
# Increment count of duplicate warnings
$dupcount++;
}
2019-06-18 04:35:08 +08:00
2020-12-22 02:57:18 +08:00
# print STDERR "name = $name\n";
# print STDERR "line = $line\n";
# print STDERR "offset = $offset\n";
# print STDERR "warning = \"$warning\"\n";
2019-06-18 04:35:08 +08:00
}
2023-12-29 22:42:35 +08:00
# Sanity check compiled source files with multiple paths when computing
# warning density
# (Check $options{d} each time, because any of the sanity checks could disable
# displaying the warning density)
if(exists $options{d}) {
sanity_check_loc("C", \%c_files, \%c_files_counted);
}
if(exists $options{d}) {
sanity_check_loc("FORTRAN", \%fort_files, \%fort_files_counted);
}
if(exists $options{d}) {
sanity_check_loc("C++", \%cpp_files, \%cpp_files_counted);
}
#
# Display results
#
print "\nTotal unique [non-ignored] warnings: $totalcount\n";
# Display warning density, if requested
if(exists $options{d}) {
print "Lines of code compiled: <total> (C/C++/FORTRAN): ", ($c_lines + $cpp_lines + $fort_lines), " ($c_lines/$cpp_lines/$fort_lines)\n";
printf "Warning density (<# of warnings> / <# of LOC compiled>): %10.10f\n", $totalcount / ($c_lines + $cpp_lines + $fort_lines);
}
2020-12-22 02:57:18 +08:00
print "Ignored notes / supplemental warning lines [not counted in unique warnings]: $notecount\n";
print "Duplicated warning lines [not counted in unique warnings]: $dupcount\n";
2019-06-18 04:35:08 +08:00
print "Total ignored warnings: $ignorecount\n";
$warncount = keys %warn_count;
print "Total unique kinds of warnings: $warncount\n";
$filecount = keys %file_count;
print "Total files with warnings: $filecount\n\n";
# Print warnings in decreasing frequency
print "# of Warnings by frequency (file count)\n";
print "=======================================\n";
for my $x (sort {$warn_count{$b} <=> $warn_count{$a}} keys(%warn_count)) {
2020-12-22 02:57:18 +08:00
printf ("[%2d] %4d (%2d) - %s\n", $current_warning++, $warn_count{$x}, scalar(keys %{$warn_file{$x}}), $x);
2019-07-03 12:43:45 +08:00
if((exists $options{W}) || (exists $options{w}) || (exists $options{s})) {
2019-06-18 04:35:08 +08:00
my $curr_index = $current_warning - 1;
2019-07-03 12:43:45 +08:00
my $match = 0;
# Check for string from list in current warning
if(exists $options{s}) {
for my $y (@warn_match_strings) {
2020-12-22 02:57:18 +08:00
# print STDERR "y = '$y'\n";
2019-07-03 12:43:45 +08:00
if($x =~ /$y/) {
2020-12-22 02:57:18 +08:00
# print STDERR "matched warning = '$x'\n";
2019-07-03 12:43:45 +08:00
$match = 1;
last;
}
}
}
# Check if current warning index matches
2019-06-18 04:35:08 +08:00
if((exists $warn_file_indices{$curr_index}) && $curr_index == $warn_file_indices{$curr_index}) {
2019-07-03 12:43:45 +08:00
$match = 1;
}
2023-12-29 22:42:35 +08:00
if($match || exists $options{W}) {
2019-06-18 04:35:08 +08:00
for my $y (sort {$warn_file{$x}{$b} <=> $warn_file{$x}{$a}} keys(%{$warn_file{$x}})) {
printf ("\t%4d - %s\n", $warn_file{$x}{$y}, $y);
if(exists $options{l}) {
2019-07-10 11:15:36 +08:00
my $lines = join ", ", sort {$a <=> $b} keys %{$warn_file_line{$x}{$y}};
2019-07-03 12:43:45 +08:00
printf("\t\tLines: $lines \n");
2019-06-18 04:35:08 +08:00
}
}
}
}
}
# Print warnings in decreasing frequency, by filename
print "\n# of Warnings by filename (warning type)\n";
print "========================================\n";
for my $x (sort {$file_count{$b} <=> $file_count{$a}} keys(%file_count)) {
2020-12-22 02:57:18 +08:00
printf ("[%3d] %4d (%2d) - %s\n", $current_file++, $file_count{$x}, scalar(keys %{$file_warn{$x}}), $x);
2019-07-06 02:31:38 +08:00
if((exists $options{F}) || (exists $options{f}) || (exists $options{S})) {
2019-06-18 04:35:08 +08:00
my $curr_index = $current_file - 1;
2019-07-03 12:43:45 +08:00
my $match = 0;
# Check for string from list in current file
if(exists $options{S}) {
for my $y (@file_match_strings) {
2020-12-22 02:57:18 +08:00
# print STDERR "y = '$y'\n";
2019-07-03 12:43:45 +08:00
if($x =~ /$y/) {
2020-12-22 02:57:18 +08:00
# print STDERR "matched warning = '$x'\n";
2019-07-03 12:43:45 +08:00
$match = 1;
last;
}
}
}
# Check if current file index matches
2019-06-18 04:35:08 +08:00
if((exists $file_warn_indices{$curr_index}) && $curr_index == $file_warn_indices{$curr_index}) {
2019-07-03 12:43:45 +08:00
$match = 1;
}
2023-12-29 22:42:35 +08:00
if($match || exists $options{F}) {
2019-06-18 04:35:08 +08:00
for my $y (sort {$file_warn{$x}{$b} <=> $file_warn{$x}{$a}} keys(%{$file_warn{$x}})) {
printf ("\t%4d - %s\n", $file_warn{$x}{$y}, $y);
if(exists $options{l}) {
2019-07-10 11:15:36 +08:00
my $lines = join ", ", sort {$a <=> $b} keys %{$file_warn_line{$x}{$y}};
2019-07-03 12:43:45 +08:00
printf("\t\tLines: $lines \n");
2019-06-18 04:35:08 +08:00
}
}
}
}
}
# Print names of files that were ignored
2019-07-06 02:31:38 +08:00
# Check for ignored file
if(exists $options{i}) {
print "\nIgnored filenames\n";
print "=================\n";
for my $x (sort keys(%ignored_files)) {
print "$x\n";
}
2019-06-18 04:35:08 +08:00
}