You can not select more than 25 topics
			Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
		
		
		
		
		
			
		
			
				
					
					
						
							549 lines
						
					
					
						
							18 KiB
						
					
					
				
			
		
		
	
	
							549 lines
						
					
					
						
							18 KiB
						
					
					
				| #!/usr/bin/env perl
 | |
| require 5.003;
 | |
| use warnings;
 | |
| 
 | |
| #
 | |
| # 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 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.
 | |
| #
 | |
| # Quincey Koziol
 | |
| #  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 $notecount = 0;
 | |
| my $dupcount = 0;
 | |
| my %warn_count = ();
 | |
| my $warncount;
 | |
| my %warn_file = ();
 | |
| my %warn_file_line = ();
 | |
| my %warn_file_line_offset = ();
 | |
| my %file_count = ();
 | |
| my $filecount;
 | |
| my $ignorecount = 0;
 | |
| my @ignorenames;
 | |
| my %ignored_files = ();
 | |
| my %warn_file_indices = ();
 | |
| my %file_warn_indices = ();
 | |
| my @warn_match_strings;
 | |
| my @file_match_strings;
 | |
| my %file_warn = ();
 | |
| my %file_warn_line = ();
 | |
| my $current_warning = 0;
 | |
| my $current_file = 0;
 | |
| my $warn_index;
 | |
| my $genericize = 1;
 | |
| 
 | |
| # Info about last name / line / offset for file
 | |
| my $last_c_name;
 | |
| my $last_fort_name;
 | |
| my $last_fort_line;
 | |
| my $last_fort_offset;
 | |
| 
 | |
| # Display usage
 | |
| sub do_help {
 | |
|     print "Usage: 'warnhist [-h, --help] [-t <prefix>] [-w <n>] [-W] [-f <n>] [-F] [-s <warning string list>] [-S <file string list] [-l] [-u] [-i <name list>] [file]'\n";
 | |
|     print "\t-h, --help\tDisplay this usage\n";
 | |
|     print "\t-t <prefix>\tTrim pathname prefix from filenames, <prefix>\n";
 | |
|     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";
 | |
|     print "\t-s <warning string list>\tDisplay files for warnings which contain a string, <warning string list>\n";
 | |
|     print "\t\t<warning string list> is a comma separated list, with no spaces\n";
 | |
|     print "\t\tFor example: 'Wunused-dummy-argument' or 'Wunused-dummy-argument,Wunused-variable'\n";
 | |
|     print "\t-S <file string list>\tDisplay warnings for files which contain a string, <file string list>\n";
 | |
|     print "\t\t<file string list> is a comma separated list, with no spaces\n";
 | |
|     print "\t\tFor example: 'H5Fint' or 'H5Fint,H5Gnode'\n";
 | |
|     print "\t-l\tDisplay line numbers for file/warning\n";
 | |
|     print "\t-u\tLeave 'unique' types in warnings, instead of genericizing them\n";
 | |
|     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";
 | |
|     print "\tfile\tFilename containing build output\n";
 | |
|     print "\t\tIf no file is given, standard input is used.\n";
 | |
|     exit;
 | |
| }
 | |
| 
 | |
| sub main::HELP_MESSAGE {
 | |
|     do_help();
 | |
| }
 | |
| 
 | |
| # declare the Perl command line flags/options we want to allow
 | |
| my %options=();
 | |
| getopts("FWhut:w:f:s:S:i:l", \%options);
 | |
| 
 | |
| # Display usage, if requested
 | |
| if($options{h}) {
 | |
|     do_help();
 | |
| }
 | |
| 
 | |
| # Parse list of file names to ignore
 | |
| if(exists $options{i}) {
 | |
|     @ignorenames = split /,/, $options{i};
 | |
| #print STDERR @ignorenames;
 | |
| }
 | |
| 
 | |
| # Parse list of warning indices to expand file names
 | |
| if(exists $options{w}) {
 | |
|     my @tmp_indices;
 | |
| 
 | |
|     @tmp_indices = split /,/, $options{w};
 | |
| #print STDERR @tmp_indices;
 | |
|     for my $x (@tmp_indices) {
 | |
| #print STDERR "x = '$x'\n";
 | |
|         if($x =~ /\-/) {
 | |
|             my $start_index;
 | |
|             my $end_index;
 | |
| 
 | |
| #print STDERR "matched = '$x'\n";
 | |
|             ($start_index, $end_index) = split /\-/, $x;
 | |
| #print STDERR "start_index = '$start_index', end_index = '$end_index'\n";
 | |
|             for my $y ($start_index..$end_index) {
 | |
| #print STDERR "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 STDERR "$_ : $warn_file_indices{$_}\n";
 | |
| #}
 | |
| }
 | |
| 
 | |
| # Parse list of warning strings to expand file names
 | |
| if(exists $options{s}) {
 | |
|     @warn_match_strings = split /,/, $options{s};
 | |
| # print STDERR @warn_match_strings;
 | |
| }
 | |
| 
 | |
| # Parse list of file indices to expand warnings
 | |
| if(exists $options{f}) {
 | |
|     my @tmp_indices;
 | |
| 
 | |
|     @tmp_indices = split /,/, $options{f};
 | |
| #print STDERR @tmp_indices;
 | |
|     for my $x (@tmp_indices) {
 | |
| #print STDERR "x = '$x'\n";
 | |
|         if($x =~ /\-/) {
 | |
|             my $start_index;
 | |
|             my $end_index;
 | |
| 
 | |
| #print STDERR "matched = '$x'\n";
 | |
|             ($start_index, $end_index) = split /\-/, $x;
 | |
| #print STDERR "start_index = '$start_index', end_index = '$end_index'\n";
 | |
|             for my $y ($start_index..$end_index) {
 | |
| #print STDERR "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 STDERR "$_ : $warn_file_indices{$_}\n";
 | |
| #}
 | |
| }
 | |
| 
 | |
| # Parse list of warning strings for files to expand warnings
 | |
| if(exists $options{S}) {
 | |
|     @file_match_strings = split /,/, $options{S};
 | |
| # print STDERR @file_match_strings;
 | |
| }
 | |
| 
 | |
| # Check if warnings should stay unique and not be "genericized"
 | |
| if($options{u}) {
 | |
|     $genericize = 0;
 | |
| }
 | |
| 
 | |
| PARSE_LINES:
 | |
| while (<>) {
 | |
|     my $name;
 | |
|     my $line;
 | |
|     my $prev_line;
 | |
|     my $toss;
 | |
|     my $offset;
 | |
|     my $warning;
 | |
|     my $extra;
 | |
|     my $extra2;
 | |
| 
 | |
|     # Retain last FORTRAN compile line, which comes a few lines before warning
 | |
|     if($_ =~ /.*\.[fF]90:.*/) {
 | |
|         ($last_fort_name, $last_fort_line, $last_fort_offset) = split /\:/, $_;
 | |
|         ($last_fort_line, $toss) = split /\./, $last_fort_line;
 | |
|     }
 | |
| 
 | |
|     # Retain last C/C++ compile line, which possibly comes a few lines before warning
 | |
|     if($_ =~ /.*[A-Za-z0-9_]\.[cC]:.*/) {
 | |
|         ($last_c_name, $toss) = split /\:/, $_;
 | |
|     }
 | |
| 
 | |
|     # Retain C/C++ compile line, which comes with the line of warning
 | |
|     if($_ =~ /.*[A-Za-z0-9_]\.[chC]\(.*[0-9]\):.*#.*/) {
 | |
|         $last_c_name = $_;
 | |
|     }
 | |
| 
 | |
|     # Skip lines that don't have the word "warning"
 | |
|     next if $_ !~ /[Ww]arning/;
 | |
| 
 | |
|     # Skip warnings from linker
 | |
|     next if $_ =~ /ld: warning:/;
 | |
| 
 | |
|     # Skip warnings from build_py and install_lib
 | |
|     next if $_ =~ /warning: (build_py|install_lib)/;
 | |
| 
 | |
|     # Skip variables with the word 'warning' in them
 | |
|     next if $_ =~ /_warning_/;
 | |
| 
 | |
|     # Skip AMD Optimizing Compiler (aocc) lines "<#> warning(s) generated."
 | |
|     next if $_ =~ / warnings? generated\./;
 | |
| 
 | |
|     # "Hide" the C++ '::' symbol until we've parsed out the parts of the line
 | |
|     while($_ =~ /\:\:/) {
 | |
| 	$_ =~ s/\:\:/@@@@/g;
 | |
|     }
 | |
| 
 | |
|     # Check for weird formatting of warning message
 | |
|     $line = "??";
 | |
|     $offset = "??";
 | |
|     if($_ =~ /^cc1: warning:.*/) {
 | |
|         $name = $last_c_name;
 | |
|         ($toss, $toss, $warning, $extra, $extra2) = split /\:/, $_;
 | |
|     # Check for CMAKE build with warning on first line and no filename
 | |
|     } elsif($_ =~ /^\s*[Ww]arning:.*/) {
 | |
|         $name = $last_c_name;
 | |
|         ($toss, $warning, $extra, $extra2) = split /\:/, $_;
 | |
|     # 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;
 | |
|     # Check for FORTRAN warning output
 | |
|     } elsif($_ =~ /^Warning:.*/) {
 | |
|         $name = $last_fort_name;
 | |
|         $line = $last_fort_line;
 | |
|         $offset = $last_fort_offset;
 | |
|         ($toss, $warning, $extra, $extra2) = split /\:/, $_;
 | |
| 
 | |
|         # 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
 | |
|         }
 | |
|     # Check for non-GCC warning (Solaris/Oracle?)
 | |
|     } elsif($_ =~ /^\".*, line [0-9]+: *[Ww]arning:.*/) {
 | |
|         ($name, $toss, $warning, $extra, $extra2) = split /\:/, $_;
 | |
|         ($name, $line) = split /\,/, $name;
 | |
| 	    $name =~ s/^\"//g;
 | |
| 	    $name =~ s/\"$//g;
 | |
| 	    $line =~ s/^\s*line\s*//g;
 | |
|     # 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;
 | |
|     } else {
 | |
|         # Check for 'character offset' field appended to file & line #
 | |
| 	# (This is probably specific to GCC)
 | |
|         if($_ =~ /^.*[0-9]+\:[0-9]+\:/) {
 | |
|             ($name, $line, $offset, $toss, $warning, $extra, $extra2) = split /\:/, $_;
 | |
|         } else {
 | |
|             ($name, $line, $toss, $warning, $extra, $extra2) = split /\:/, $_;
 | |
|         }
 | |
|     }
 | |
| 
 | |
|     # Check for extra ':' followed by more text in original warning string,
 | |
|     #  and append the ':' and text back onto the parsed warning
 | |
|     #  (Use 'length $extra' idiom to avoid warning when $extra is undefined)
 | |
|     if(length $extra ) {
 | |
|         $warning = join ':', $warning, $extra;
 | |
|     }
 | |
|     if(length $extra2 ) {
 | |
|         $warning = join ':', $warning, $extra2;
 | |
|     }
 | |
| 
 | |
|     # Restore the C++ '::' symbol now that we've parsed out the parts of the line
 | |
|     while($warning =~ /@@@@/) {
 | |
|         $warning =~ s/@@@@/\:\:/g;
 | |
|     }
 | |
| 
 | |
|     # 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
 | |
|     }
 | |
| 
 | |
|     # 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;
 | |
|     $warning =~ s/"/'/g;
 | |
| 
 | |
| #
 | |
| # These skipped messages & "genericizations" may be specific to GCC
 | |
| 
 | |
|     # Skip supplemental warning message
 | |
|     if($warning =~ /near initialization for/) {
 | |
| 	$notecount++;
 | |
|         next
 | |
|     }
 | |
| 
 | |
|     # Skip C++ supplemental warning message
 | |
|     if($warning =~ /in call to/) {
 | |
| 	$notecount++;
 | |
|         next
 | |
|     }
 | |
| 
 | |
|     # Skip GCC warning that should be a note
 | |
|     if($_ =~ /\(this will be reported only once per input file\)/) {
 | |
| 	$notecount++;
 | |
|         next
 | |
|     }
 | |
| 
 | |
|     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;
 | |
| 	}
 | |
| 
 | |
| 	# 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;
 | |
| 	}
 | |
| 	if($warning =~ /'%[\#0\-\ \+]*[,;\:_]?[0-9\*]*\.?[0-9\*]*[hjltzL]*[aAcdeEfFgGinosuxX]'/) {
 | |
| 	    $warning =~ s/'%[\#0\-\ \+]*[,;\:_]?[0-9\*]*\.?[0-9\*]*[hjltzL]*[aAcdeEfFgGinosuxX]'/'-'/g;
 | |
| 	}
 | |
| 
 | |
| 	# Genericize C/C++ "<macro>" warnings into "-"
 | |
| 	if($warning =~ /"[A-Za-z_0-9]*"/) {
 | |
| 	    $warning =~ s/"[A-Za-z_0-9]*"/"-"/g;
 | |
| 	}
 | |
| 
 | |
| 	# Genericize [GCC?] C/C++ warning text about suggested attribute
 | |
| 	if($warning =~ /attribute=[A-Za-z_0-9]*\]/) {
 | |
| 	    $warning =~ s/=[A-Za-z_0-9]*\]/=-\]/g;
 | |
| 	}
 | |
| 
 | |
| 	# 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
 | |
| 	if($warning =~ /(\s|')-?[0-9]+(\s|')/) {
 | |
| 	    $warning =~ s/-?[0-9]+/-/g;
 | |
| 	}
 | |
| 
 | |
| 	# 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;
 | |
| 	}
 | |
|     }
 | |
| # <end possible GCC-specific code>
 | |
| 
 | |
|     # Check if we've already seen this warning on this line in this file
 | |
|     # (Can happen for warnings from inside header files)
 | |
|     if( !exists $warn_file_line_offset{$warning}{$name}{$line}{$offset} ) {
 | |
| 	# Increment count for [generic] warning
 | |
| 	$warn_count{$warning}++;
 | |
| 	$warn_file{$warning}{$name}++;
 | |
| 	$warn_file_line{$warning}{$name}{$line}++;
 | |
| 	$warn_file_line_offset{$warning}{$name}{$line}{$offset}++;
 | |
| 
 | |
| 	# Increment count for filename
 | |
| 	$file_count{$name}++;
 | |
| 	$file_warn{$name}{$warning}++;
 | |
| 	$file_warn_line{$name}{$warning}{$line}++;
 | |
| 
 | |
| 	# Increment total count of warnings
 | |
| 	$totalcount++;
 | |
|     }
 | |
|     else {
 | |
| 	# Increment count of duplicate warnings
 | |
| 	$dupcount++;
 | |
|     }
 | |
| 
 | |
| #    print STDERR "name = $name\n";
 | |
| #    print STDERR "line = $line\n";
 | |
| #    print STDERR "offset = $offset\n";
 | |
| #    print STDERR "warning = \"$warning\"\n";
 | |
| }
 | |
| 
 | |
| print "Total unique [non-ignored] warnings: $totalcount\n";
 | |
| print "Ignored notes / supplemental warning lines [not counted in unique warnings]: $notecount\n";
 | |
| print "Duplicated warning lines [not counted in unique warnings]: $dupcount\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{$x}}), $x);
 | |
|     if((exists $options{W}) || (exists $options{w}) || (exists $options{s})) {
 | |
|         my $curr_index = $current_warning - 1;
 | |
| 	my $match = 0;
 | |
| 
 | |
| 	# Check for string from list in current warning
 | |
| 	if(exists $options{s}) {
 | |
| 	    for my $y (@warn_match_strings) {
 | |
| # print STDERR "y = '$y'\n";
 | |
| 		if($x =~ /$y/) {
 | |
| # print STDERR "matched warning = '$x'\n";
 | |
| 		    $match = 1;
 | |
| 		    last;
 | |
| 		}
 | |
| 	    }
 | |
| 	}
 | |
| 
 | |
| 	# Check if current warning index matches
 | |
|         if((exists $warn_file_indices{$curr_index}) && $curr_index == $warn_file_indices{$curr_index}) {
 | |
| 	    $match = 1;
 | |
| 	}
 | |
| 
 | |
|         if($match) {
 | |
|             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}) {
 | |
| 		    my $lines = join ", ", sort {$a <=> $b} keys %{$warn_file_line{$x}{$y}};
 | |
|                     printf("\t\tLines: $lines \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{$x}}), $x);
 | |
|     if((exists $options{F}) || (exists $options{f}) || (exists $options{S})) {
 | |
|         my $curr_index = $current_file - 1;
 | |
| 	my $match = 0;
 | |
| 
 | |
| 	# Check for string from list in current file
 | |
| 	if(exists $options{S}) {
 | |
| 	    for my $y (@file_match_strings) {
 | |
| # print STDERR "y = '$y'\n";
 | |
| 		if($x =~ /$y/) {
 | |
| # print STDERR "matched warning = '$x'\n";
 | |
| 		    $match = 1;
 | |
| 		    last;
 | |
| 		}
 | |
| 	    }
 | |
| 	}
 | |
| 
 | |
| 	# Check if current file index matches
 | |
|         if((exists $file_warn_indices{$curr_index}) && $curr_index == $file_warn_indices{$curr_index}) {
 | |
| 	    $match = 1;
 | |
| 	}
 | |
| 
 | |
|         if($match) {
 | |
|             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}) {
 | |
| 		    my $lines = join ", ", sort {$a <=> $b} keys %{$file_warn_line{$x}{$y}};
 | |
|                     printf("\t\tLines: $lines \n");
 | |
|                 }
 | |
|             }
 | |
|         }
 | |
|     }
 | |
| }
 | |
| 
 | |
| # Print names of files that were ignored
 | |
| # Check for ignored file
 | |
| if(exists $options{i}) {
 | |
|     print "\nIgnored filenames\n";
 | |
|     print   "=================\n";
 | |
|     for my $x (sort keys(%ignored_files)) {
 | |
| 	print "$x\n";
 | |
|     }
 | |
| }
 | |
| 
 | |
| 
 |