#!/usr/bin/perl -w # # $Id$ # # ************************************************************* # # Licensed to the Apache Software Foundation (ASF) under one # or more contributor license agreements. See the NOTICE file # distributed with this work for additional information # regarding copyright ownership. The ASF licenses this file # to you under the Apache License, Version 2.0 (the # "License"); you may not use this file except in compliance # with the License. You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, # software distributed under the License is distributed on an # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY # KIND, either express or implied. See the License for the # specific language governing permissions and limitations # under the License. # # ************************************************************* # GCOV_FILTER # # Helper to filter the gcov output. # Handle a compare between the hole gcov output and a given select list of exported functions. # # Q: Why perl? # A: regexp ;-) # use strict; use File::Basename; use Getopt::Long; # Global constants our $version_info = 'gcov helper $Revision: 1.4 $ '; our $help; # Help option flag our $version; # Version option flag our $cwd = `pwd`; # current working directory chomp($cwd); # our $tool_dir = dirname($0); # our $tool_file = basename($0); # our $output_filename; our $input_allfunc; # our $input_filename; our $allfuncinfo; # allfuncinfo option flag our $showallfunc; # showallfunc option flag our $no_percentage; # no_percentage option flag our $donotfilter; # donotfilter option flag our $objectdir; # Prototypes sub print_usage(*); sub read_gcov_function_file($); sub get_PRJ_from_makefile_mk(); # sub read_ExportedFunctionList(); sub read_List($); # if (! ($tool_dir =~ /^\/(.*)$/)) # { # $tool_dir = "$cwd/$tool_dir"; # } # Parse command line options if (!GetOptions( "input-allfunc=s" => \$input_allfunc, "allfuncinfo" => \$allfuncinfo, "showallfunc" => \$showallfunc, "no-percentage" => \$no_percentage, "do-not-filter" => \$donotfilter, "objectdir=s" => \$objectdir, "help" => \$help, "version" => \$version )) { print_usage(*STDERR); exit(1); } # Check for help option if ($help) { print_usage(*STDOUT); exit(0); } # Check for version option if ($version) { print("$version_info\n"); exit(0); } # check if enough parameters if ($#ARGV < 0) { print("No input filename specified\n"); print_usage(*STDERR); exit(1); } # special case: # the filename contains a . or '/' at the beginning my $startdir = $ARGV[0]; if ( ($startdir =~ /^\.\./) || ($startdir =~ /^\//) ) { $startdir = dirname($startdir); # print("start directory is $startdir\n"); # chdir $startdir; } else { $startdir = ""; } # check for sal.map if ( ! $input_allfunc ) { # this is a try, to get the project directory form a found makefile.mk # may work, but fails due to some disunderstandings may be problems in perl :-( my $sDir = get_PRJ_from_makefile_mk(); # chomp($sDir); # HDW: print("PRJ is $dir\n"); # $sDir2 = "../.."; my $sMapFile = "$sDir" . "/util/sal.map"; # $sMapFile = "$sDir2" . "/util/sal.map"; if ( -e $sMapFile) { $input_allfunc = $sMapFile; } else { print("No input-allfunc filename specified\n"); print_usage(*STDERR); exit(1); } } our @aDeprecatedList; our @aExportedFunctionList; # read_ExportedFunctionList(); @aExportedFunctionList = read_List($input_allfunc); @aDeprecatedList = read_List("deprecated.txt"); if ($allfuncinfo) { print("Count of all functions: $#aExportedFunctionList\n"); exit(0); } if ($showallfunc) { my $func; foreach $func (@aExportedFunctionList) { print("$func\n"); } exit(0); } # back to current directory # this chdir was for a before chdir (in $startdir creation) but due to the fact, # that the get_PRJ_from_makefile_mk works but the after concat of strings not, this # chdir is also remarked. # chdir $cwd; # HWD: print "count of param: \n"; # $input_filename = $ARGV[0]; my $nCount = $#ARGV + 1; my $nIdx; for ($nIdx = 0; $nIdx < $nCount ; ++$nIdx) { my $file = $ARGV[$nIdx]; # print("processing: $file\n"); # change directory, to the current file, due to the fact, that we may be need to call gcov # and gcov will create some extra files, like *.gcov near the current file. # if ( $startdir ne "" ) # { # chdir $startdir; # $file = basename($file); # } my $OBJECTS=""; if ($objectdir) { $OBJECTS = "-o " . $objectdir; } if (! ($file =~ /\.f$/ )) { my $filef = "$file.f"; # if (! -e $filef ) # { # print "gcov $OBJECTS -l -f $file >$filef\n"; my $blah = `gcov $OBJECTS -n -f $file >$filef`; # } $file = $filef; } read_gcov_function_file($file); # go back to old directory, because it's possible to change relative to an other directory. if ( $startdir ne "" ) { chdir $cwd; } } # print "$tool_dir\n"; # print "all is right\n"; exit(0); # -------------------------------------------------------------------------------- # Read the map file, which should contain all exported functions. sub read_List($) { local *INPUT_HANDLE; my $filename = $_[0]; my @list; my $line = ""; open(INPUT_HANDLE, $filename); # or die("ERROR: cannot open $filename!\n"); while ($line = ) { chomp($line); # reg exp: [spaces]functionname[semicolon][line end] if ($line =~ /^\s+(\w*);$/) { # print("$1\n"); push(@list, $1); } } close(INPUT_HANDLE); return @list; } # -------------------------------------------------------------------------------- # Helper function, test is a given value is found in the global exported function list. # the given value format could be a simple function name # or a prototype # e.g. # osl_getSystemPathFromFileURL # or # void getSystemPathFromFileURL( const char* rtl_...) # sub contain_in_List($$) { my $func; my $value = $_[0]; my $list = $_[1]; if ($donotfilter) { return $value; } foreach $func (@$list) # (@aExportedFunctionList) { # first try, direct check if ($value eq $func) { # HWD: print("$value eq $func\n"); return $value; } # value not found, second try, may be we found it if we search word wise. # helper, to insert a space after the word, before '(' $value =~ s/\(/ \(/g; # may be here we should replace all white spaces by ' ' # split by 'space' my @list = split(' ', $value); for(@list) { # HWD: print "$list[$n]\n"; if ($_ eq $func) { # HWD: print ("found $func in $value\n"); return $_; } } } # not found return ""; } # -------------------------------------------------------------------------------- # Read the gcov function (gcov -f) file # and compare line by line with the export function list # so we get a list of functions, which are only exported, and not all stuff. # sample of output # new gcov gcc 3.4 format sub read_gcov_function_file($) { local *INPUT_HANDLE; my $file = $_[0]; my $line = ""; open(INPUT_HANDLE, $file) or die("ERROR: cannot open $file!\n"); while ($line = ) { chomp($line); # sample line (for reg exp:) # 100.00% of 3 source lines executed in function osl_thread_init_Impl if ($line =~ /^Function \`(.*)\'$/ ) { my $sFunctionName = $1; my $sPercentage; $line = ; if ($line =~ /^Lines executed:(.*)% of/ ) { $sPercentage = $1; } my $value = contain_in_List( $sFunctionName, \@aExportedFunctionList ); if ($value) { my $isDeprecated = contain_in_List( $sFunctionName, \@aDeprecatedList ); if ($isDeprecated) { # Function is deprecated, do not export it. } else { if ($no_percentage) { print("$value\n"); } else { print("$sPercentage $value\n"); } } } # push(@aExportedFunctionList, $1); } } close(INPUT_HANDLE); } # gcov format since gcc 3.3.6 # 100.00% von 3 Zeilen in function helloworld ausgeführt # 100.00% von 5 Zeilen in function main ausgeführt # 100.00% von 8 Zeilen in file tmp.c ausgeführt sub read_gcov_function_file_old_gcc_3($) { local *INPUT_HANDLE; my $file = $_[0]; my $line = ""; open(INPUT_HANDLE, $file) or die("ERROR: cannot open $file!\n"); while ($line = ) { chomp($line); # sample line (for reg exp:) # 100.00% of 3 source lines executed in function osl_thread_init_Impl if ($line =~ /^(.*)% of \d+ source lines executed in function (.*)$/ ) { my $value = contain_in_List( $2, \@aExportedFunctionList ); if ($value) { my $isDeprecated = contain_in_List( $2, \@aDeprecatedList ); if ($isDeprecated) { # Function is deprecated, do not export it. } else { if ($no_percentage) { print("$value\n"); } else { print("$1 $value\n"); } } } # push(@aExportedFunctionList, $1); } } close(INPUT_HANDLE); } # ------------------------------------------------------------------------------ # helper, to read the PRJ value out of a makefile.mk file sub get_PRJ_from_makefile_mk() { local *INPUT_HANDLE; # my $startdir = @_[0]; my $line = ""; my $value = ""; open(INPUT_HANDLE, "makefile.mk") or die("ERROR: cannot open makefile.mk\n"); while ($line = ) { chomp($line); # sample line # PRJ= # HWD: print("$line\n"); if ($line =~ /^PRJ\s*=(.*)\s*$/) { # HWD: print("FOUND #####\n"); $value = $1; chomp($value); $value =~ s/\$\//\//g; } } close(INPUT_HANDLE); return $value; } # ---------------------------------------------------------------------------- sub print_usage(*) { local *HANDLE = $_[0]; my $tool_name = basename($0); print(HANDLE <