#!/usr/bin/perl -w require 5.003; # # 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 # the files COPYING and Copyright.html. COPYING can be found at the root # of the source code distribution tree; Copyright.html can be found at the # root level of an installed copy of the electronic HDF5 document set and # is linked from the top-level documents page. It can also be found at # http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have # access to either file, you may request a copy from help@hdfgroup.org. # # Quincey Koziol, koziol@hdfgroup.org # 9 Aug 2013 # # 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; # Global variables, for accumulating information my $totalcount = 0; my %warn_count = (); my $warncount; my %warn_file = (); my %warn_file_line = (); my %file_count = (); my $filecount; my $ignorecount = 0; my @ignorenames; my %ignored_files = (); my %warn_file_indices = (); my %file_warn_indices = (); my %file_warn = (); my %file_warn_line = (); my $current_warning = 0; my $current_file = 0; my $warn_index; my $last_c_name; my $last_fort_name; my $last_fort_line; # declare the Perl command line flags/options we want to allow my %options=(); getopts("FWht:w:f:i:l", \%options); # Display usage, if requested if($options{h}) { print "Usage: 'warnhist [-h] [-t ] [-w ] [-W] [-f ] [-F] [-l] [-i [file]'\n"; print "\t-h\tDisplay this usage\n"; print "\t-t \tTrim pathname prefix from filenames, \n"; print "\t-w \tDisplay files for a given warning index list, \n"; print "\t\t 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 \tDisplay warnings for a given file index list, \n"; print "\t\t 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"; print "\t-l\tDisplay line nunbers for file/warning\n"; print "\t-i \tIgnore named files, \n"; print "\t\t is a comma separated list, with no spaces\n"; print "\t\tFor example: 'H5LTparse' or 'H5LTparse,H5LTanalyze'\n"; print "\tfile\tFilename containing build output\n"; print "\t\tIf no file is given, standard input is used.\n"; exit; } # Parse list of file names to ignore if(exists $options{i}) { @ignorenames = split /,/, $options{i}; #print @ignorenames; } # Parse list of warning indices to expand file names if(exists $options{w}) { my @tmp_indices; @tmp_indices = split /,/, $options{w}; #print @tmp_indices; for my $x (@tmp_indices) { #print "x = '$x'\n"; if($x =~ /\-/) { my $start_index; my $end_index; #print "matched = '$x'\n"; ($start_index, $end_index) = split /\-/, $x; #print "start_index = '$start_index', end_index = '$end_index'\n"; for my $y ($start_index..$end_index) { #print "y = '$y'\n"; if(!(exists $warn_file_indices{$y})) { $warn_file_indices{$y} = $y; } } } else { if(!(exists $warn_file_indices{$x})) { $warn_file_indices{$x} = $x; } } } #foreach (sort keys %warn_file_indices) { # print "$_ : $warn_file_indices{$_}\n"; #} } # Parse list of file indices to expand warnings if(exists $options{f}) { my @tmp_indices; @tmp_indices = split /,/, $options{f}; #print @tmp_indices; for my $x (@tmp_indices) { #print "x = '$x'\n"; if($x =~ /\-/) { my $start_index; my $end_index; #print "matched = '$x'\n"; ($start_index, $end_index) = split /\-/, $x; #print "start_index = '$start_index', end_index = '$end_index'\n"; for my $y ($start_index..$end_index) { #print "y = '$y'\n"; if(!(exists $file_warn_indices{$y})) { $file_warn_indices{$y} = $y; } } } else { if(!(exists $file_warn_indices{$x})) { $file_warn_indices{$x} = $x; } } } #foreach (sort keys %warn_file_indices) { # print "$_ : $warn_file_indices{$_}\n"; #} } PARSE_LINES: while (<>) { my $name; my $line; my $prev_line; my $toss; my $offset; my $warning; # Retain last FORTRAN compile line, which comes a few lines before warning if($_ =~ /.*\.[fF]90:.*/) { ($last_fort_name, $last_fort_line, $toss) = split /\:/, $_; ($last_fort_line, $toss) = split /\./, $last_fort_line; } # Retain last C compile line, which possibly comes a few lines before warning if($_ =~ /.*[A-Za-z0-9_]\.c:.*/) { ($last_c_name, $toss) = split /\:/, $_; } next if $_ !~ /[Ww]arning:/; # Skip warnings from linker next if $_ =~ /ld: warning:/; # Check for weird formatting of warning message if($_ =~ /^cc1: warning:.*/) { $name = $last_c_name; $line = "??"; ($toss, $toss, $warning) = split /\:/, $_; # Check for FORTRAN warning output } elsif($_ =~ /^Warning:.*/) { $name = $last_fort_name; $line = $last_fort_line; ($toss, $warning) = split /\:/, $_; #print "1:",$.,":",$_; # $_ = <>; #print "2:",$.,":",$_; # if($_ =~ /^\sFC.*/) { # $_ = <>; #print "3:",$.,":",$_; # } # ($name, $line, $toss) = split /\:/, $_; #print "4:","'",$name,"'","-","'",$line,"'","\n"; # 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 } } else { # Check for 'character offset' field if($_ =~ /^.*[0-9]+\:[0-9]+\:/) { ($name, $line, $offset, $toss, $warning) = split /\:/, $_; } else { ($name, $line, $toss, $warning) = split /\:/, $_; } } # 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) { #print "x = '$x'\n"; if($name =~ /$x/) { # print "matched name = '$name'\n"; $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 } # 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; # Skip supplemental warning message next if $warning =~ /near initialization for/; # Skip GCC warning that should be a note next if $_ =~ /\(this will be reported only once per input file\)/; # Eliminate "{aka }" info if($warning =~ /\s\{aka [A-Za-z_0-9\s\*]*\}'/) { $warning =~ s/\s\{aka [A-Za-z_0-9\s\*]*\}//g; } # Genericize warnings if($warning =~ /variable '[A-Za-z_0-9]*' set but not used.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /unused variable '[A-Za-z_0-9]*'.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /implicit conversion from '[A-Za-z_0-9]*' to '[A-Za-z_0-9]*' when passing argument to function.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /implicit conversion from '[A-Za-z_0-9]*' to '[A-Za-z_0-9]*' to match other operand of binary expression.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /conversion to '[A-Za-z_0-9\s]*' from '[A-Za-z_0-9\s]*' may alter its value.*/) { $warning =~ s/'[A-Za-z_0-9\s]*'/'-'/g; } elsif($warning =~ /conversion to '[A-Za-z_0-9\s]*' from '[A-Za-z_0-9\s]*' may change the sign of the result.*/) { $warning =~ s/'[A-Za-z_0-9\s]*'/'-'/g; } elsif($warning =~ /passing argument [0-9]* of '[A-Za-z_0-9\s]*' discards '[A-Za-z_0-9\s]*'.*/) { $warning =~ s/passing argument [0-9]*/passing argument -/g; $warning =~ s/'[A-Za-z_0-9\s]*'/'-'/g; } elsif($warning =~ /'[A-Za-z_0-9\s]*' defined but not used.*/) { $warning =~ s/'[A-Za-z_0-9\s]*'/'-'/g; } elsif($warning =~ /cast discards '[A-Za-z_0-9\(\)\s]*'.*/) { $warning =~ s/'[A-Za-z_0-9\(\)\s]*'/'-'/g; } elsif($warning =~ /size of '[A-Za-z_0-9\(\)\s\*]*' is [0-9]* bytes.*/) { $warning =~ s/is [0-9]* bytes/is - bytes/g; $warning =~ s/'[A-Za-z_0-9\(\)\s\*]*'/'-'/g; } elsif($warning =~ /passing argument [0-9]* of '[A-Za-z_0-9\(\)\s]*' from incompatible.*/) { $warning =~ s/passing argument [0-9]*/passing argument -/g; $warning =~ s/'[A-Za-z_0-9\(\)\s]*'/'-'/g; } elsif($warning =~ /stack usage is [0-9]* bytes.*/) { $warning =~ s/stack usage is [0-9]*/stack usage is -/g; } elsif($warning =~ /stack usage might be [0-9]* bytes.*/) { $warning =~ s/stack usage might be [0-9]*/stack usage might be -/g; } elsif($warning =~ /the frame size of [0-9]* bytes is larger than [0-9]* bytes.*/) { $warning =~ s/the frame size of [0-9]* bytes is larger than [0-9]*/the frame size of - bytes is larger than -/g; } elsif($warning =~ /enumeration value '[A-Za-z_0-9\s]*' not handled in switch.*/) { $warning =~ s/'[A-Za-z_0-9\s]*'/'-'/g; } elsif($warning =~ /"[A-Za-z_0-9\s]*" is not defined.*/) { $warning =~ s/"[A-Za-z_0-9\s]*"/"-"/g; } elsif($warning =~ /macro "[A-Za-z_0-9\s]*" is not used.*/) { $warning =~ s/"[A-Za-z_0-9\s]*"/"-"/g; } elsif($warning =~ /unused parameter '[A-Za-z_0-9\s]*'.*/) { $warning =~ s/'[A-Za-z_0-9\s]*'/'-'/g; } elsif($warning =~ /request for implicit conversion from '[A-Za-z_0-9\s\*]*' to '[A-Za-z_0-9\s\<\>\[\]\(\)\*]*' not permitted in C\+\+.*/) { $warning =~ s/'[A-Za-z_0-9\s\*\<\>\[\]\(\)]*'/'-'/g; } elsif($warning =~ /no previous prototype for '[A-Za-z_0-9\s]*'.*/) { $warning =~ s/'[A-Za-z_0-9\s]*'/'-'/g; } elsif($warning =~ /declaration of '[A-Za-z_0-9\s]*' shadows a previous local.*/) { $warning =~ s/'[A-Za-z_0-9\s]*'/'-'/g; } elsif($warning =~ /cast from function call of type '[A-Za-z_0-9\s\*]*' to non-matching type '[A-Za-z_0-9\s\*]*'.*/) { $warning =~ s/'[A-Za-z_0-9\s\*]*'/'-'/g; } elsif($warning =~ /'[A-Za-z_0-9\s]*' declared '[A-Za-z_0-9\s]*' but never defined.*/) { $warning =~ s/'[A-Za-z_0-9\s]*'/'-'/g; } elsif($warning =~ /declaration of '[A-Za-z_0-9\s]*' shadows a global declaration.*/) { $warning =~ s/'[A-Za-z_0-9\s]*'/'-'/g; } elsif($warning =~ /typedef '[A-Za-z_0-9\s]*' locally defined but not used.*/) { $warning =~ s/'[A-Za-z_0-9\s]*'/'-'/g; } elsif($warning =~ /format '%[a-z]*' expects argument of type '[A-Za-z_0-9\s\*]*', but argument [0-9]* has type '[A-Za-z_0-9\s\*\(\),]*'.*/) { $warning =~ s/but argument [0-9]*/but argument -/g; $warning =~ s/'[%A-Za-z_0-9\s\*\(\),]*'/'-'/g; } elsif($warning =~ /conversion to '[A-Za-z_0-9\s]*' alters '[A-Za-z_0-9\s]*' constant value.*/) { $warning =~ s/'[A-Za-z_0-9\s]*'/'-'/g; } elsif($warning =~ /to be safe all intermediate pointers in cast from '[A-Za-z_0-9\s\*]*' to '[A-Za-z_0-9\s\*]*' must be 'const' qualified.*/) { $warning =~ s/'[A-Za-z_0-9\s\*]*'/'-'/g; } elsif($warning =~ /identifier '[A-Za-z_0-9]*' conflicts with C\+\+ keyword.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /nested extern declaration of '[A-Za-z_0-9]*'.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /Procedure '[A-Za-z_0-9]*' called with an implicit interface.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /Unused dummy argument '[A-Za-z_0-9]*'.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /Unused parameter '[A-Za-z_0-9]*' declared at.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /Unused variable '[A-Za-z_0-9]*' declared at.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /Inequality comparison for REAL\([0-9]*\) at.*/) { $warning =~ s/REAL\([0-9]*\)/REAL\(-\)/g; } elsif($warning =~ /Possible change of value in conversion from INTEGER\([0-9]*\) to (INTEGER|REAL)\([0-9]*\) at.*/) { $warning =~ s/INTEGER\([0-9]*\)/INTEGER\(-\)/g; $warning =~ s/REAL\([0-9]*\)/REAL\(-\)/g; } elsif($warning =~ /passing argument [0-9]* of '[A-Za-z_0-9]*' with different width due to prototype.*/) { $warning =~ s/passing argument [0-9]*/passing argument -/g; $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /passing argument [0-9]* of '[A-Za-z_0-9]*' as unsigned due to prototype.*/) { $warning =~ s/passing argument [0-9]*/passing argument -/g; $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /passing argument [0-9]* of '[A-Za-z_0-9]*' discards qualifiers from pointer target type.*/) { $warning =~ s/passing argument [0-9]*/passing argument -/g; $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /passing argument [0-9]* of '[A-Za-z_0-9]*' as floating rather than integer due to prototype.*/) { $warning =~ s/passing argument [0-9]*/passing argument -/g; $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /passing argument [0-9]* of '[A-Za-z_0-9]*' as 'float' rather than 'double' due to prototype.*/) { $warning =~ s/passing argument [0-9]*/passing argument -/g; $warning =~ s/'[A-Za-z_0-9]*'/'-'/; } elsif($warning =~ /passing argument [0-9]* of '[A-Za-z_0-9]*' as signed due to prototype.*/) { $warning =~ s/passing argument [0-9]*/passing argument -/g; $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /format '\%[A-Za-z0-9]*' expects type '[a-z][a-z\s\*]*', but argument [0-9]* has type '[a-z][a-z\(\)_,\s\*]*'.*/) { $warning =~ s/but argument [0-9]*/but argument -/g; $warning =~ s/'\%[A-Za-z0-9]*'/'\%-'/g; $warning =~ s/'[a-z][a-z_,\s\*\(\)]*'/'-'/g; } elsif($warning =~ /implicit declaration of function '[A-Za-z_0-9]*'.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /'[A-Za-z_\.\[\]0-9]*' may be used uninitialized in this function.*/) { $warning =~ s/'[A-Za-z_\.\[\]0-9]*'/'-'/g; } elsif($warning =~ /redundant redeclaration of '[A-Za-z_0-9]*'.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /declaration of '[A-Za-z_0-9]*' shadows a parameter.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /ISO C90 does not support the '[a-z]*' gnu_scanf length modifier.*/) { $warning =~ s/'[a-z]*'/'-'/g; } elsif($warning =~ /ISO C90 does not support the '[a-z]*' gnu_printf length modifier.*/) { $warning =~ s/'[a-z]*'/'-'/g; } elsif($warning =~ /ISO C90 does not support the '%[a-z]*' gnu_printf format.*/) { $warning =~ s/'%[a-z]*'/'%-'/g; } elsif($warning =~ /string length '[0-9]*' is greater than the length.*/) { $warning =~ s/string length '[0-9]*' is/string length '-' is/g; } elsif($warning =~ /enum conversion when passing argument [0-9]* of '[A-Za-z_0-9]*' is invalid.*/) { $warning =~ s/passing argument [0-9]*/passing argument -/g; $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /duplicate declaration of '[A-Za-z_0-9]*' is invalid in.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; } elsif($warning =~ /Variable '[A-Za-z_0-9]*' at \([0-9]*\) is a dummy argument of the BIND\(C\) procedure '[A-Za-z_0-9]*' but may not be C interoperable.*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; $warning =~ s/at \([0-9]*\)/at \(-\)/g; } elsif($warning =~ /Variable '[A-Za-z_0-9]*' at \([0-9]*\) may not be a C interoperable kind but it is BIND\(C\).*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; $warning =~ s/at \([0-9]*\)/at \(-\)/g; } elsif($warning =~ /Component '[A-Za-z_0-9]*' in derived type '[A-Za-z_0-9]*' at \([0-9]*\) may not be C interoperable, even though derived type '[A-Za-z_0-9]*' is BIND\(C\).*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; $warning =~ s/at \([0-9]*\)/at \(-\)/g; } elsif($warning =~ /function might be candidate for attribute '[A-Za-z_0-9]*' if it is known to return normally \[-Wsuggest-attribute=[A-Za-z_0-9]*\].*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; $warning =~ s/=[A-Za-z_0-9]*\]/=-\]/g; } elsif($warning =~ /function might be candidate for attribute '[A-Za-z_0-9]*' \[-Wsuggest-attribute=[A-Za-z_0-9]*\].*/) { $warning =~ s/'[A-Za-z_0-9]*'/'-'/g; $warning =~ s/=[A-Za-z_0-9]*\]/=-\]/g; } # Increment count for [generic] warning $warn_count{$warning}++; $warn_file{$warning}{$name}++; push(@{ $warn_file_line{$warning}{$name} }, $line); # Increment count for filename $file_count{$name}++; $file_warn{$name}{$warning}++; push(@{ $file_warn_line{$name}{$warning} }, $line); # Increment total count of warnings $totalcount++; # print "name = $name\n"; # print "line = $line\n"; # print "offset = $offset\n"; # print "warning = \"$warning\"\n"; } print "Total [non-ignored] warnings: $totalcount\n"; 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)) { printf ("[%2d] %4d (%2d) - %s\n", $current_warning++, $warn_count{$x}, scalar(keys %{$warn_file_line{$x}}), $x); if((exists $options{W}) || (exists $options{w})) { my $curr_index = $current_warning - 1; if((exists $warn_file_indices{$curr_index}) && $curr_index == $warn_file_indices{$curr_index}) { 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}) { printf ("\t\tLines: "); for my $z ( @{ $warn_file_line{$x}{$y} } ) { printf ("%s, ", $z); } printf("\n"); } } } } } # 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)) { printf ("[%3d] %4d (%2d) - %s\n", $current_file++, $file_count{$x}, scalar(keys %{$file_warn_line{$x}}), $x); if((exists $options{F}) || (exists $options{f})) { my $curr_index = $current_file - 1; if((exists $file_warn_indices{$curr_index}) && $curr_index == $file_warn_indices{$curr_index}) { 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}) { printf ("\t\tLines: "); for my $z ( @{ $file_warn_line{$x}{$y} } ) { printf ("%s, ", $z); } printf("\n"); } } } } } # Print names of files that were ignored print "\nIgnored filenames\n"; print "=================\n"; for my $x (sort keys(%ignored_files)) { print "$x\n"; }