360 lines
9.4 KiB
Perl
360 lines
9.4 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# Copyright (C) 2001-2023 Graeme Walker <graeme_walker@users.sourceforge.net>
|
|
#
|
|
# This program is free software: you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation, either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
# ===
|
|
#
|
|
# Reduce.pm
|
|
#
|
|
# Does trial builds in order to identify unused functions in a
|
|
# given source file; emits the results to a data file; uses
|
|
# the data file to edit the source file and comment-out those
|
|
# functions.
|
|
#
|
|
# Synposis:
|
|
# use Reduce ;
|
|
# my $reduce = new Reduce( ['make foo','make bar'] , {quiet=>1,debug=>1} ) ;
|
|
# $reduce->check( "foo.cpp" ) ;
|
|
# $reduce->check( "bar.cpp" ) ;
|
|
# $reduce->emit( new FileHandle("reduce.dat","w") ) ;
|
|
# #later...
|
|
# $reduce = new Reduce( undef , {quiet=>1} ) ;
|
|
# $reduce->read( "reduce.dat" ) ;
|
|
# $reduce->edit( "foo.cpp" , "foo.cpp.new" ) && rename("foo.cpp.new","foo.cpp") or die ;
|
|
# $reduce->edit( "bar.cpp" , "bar.cpp.new" ) && rename("bar.cpp.new","bar.cpp") or die ;
|
|
#
|
|
# The results file is tab-separated with these columns:
|
|
# 1. <basename> (eg. gstr.cpp)
|
|
# 2. <line-number>
|
|
# 3. {keep|remove}
|
|
# 4. c++ signature
|
|
#
|
|
|
|
use strict ;
|
|
use Carp ;
|
|
use File::Basename ;
|
|
use Functions ;
|
|
|
|
package Reduce ;
|
|
|
|
sub new
|
|
{
|
|
my ( $classname , $make_commands , $opt ) = @_ ;
|
|
if(!defined($make_commands)) { $make_commands = ["make -C .."] }
|
|
my $this = bless {
|
|
m_data => {} ,
|
|
m_verbose => ( $opt->{quiet} ? 0 : 1 ) ,
|
|
m_comment_out => "" ,
|
|
m_ifndef => "#ifndef G_LIB_SMALL" ,
|
|
m_endif => "#endif" ,
|
|
m_make_commands => $make_commands ,
|
|
m_debug => $opt->{debug} ,
|
|
} , $classname ;
|
|
return $this ;
|
|
}
|
|
|
|
sub basenames
|
|
{
|
|
# Returns the basenames from read()/check().
|
|
my ( $this ) = @_ ;
|
|
return keys %{$this->{m_data}} ;
|
|
}
|
|
|
|
sub read
|
|
{
|
|
# Reads in the reduce file.
|
|
my ( $this , $reduce_file ) = @_ ;
|
|
return if !$reduce_file ;
|
|
$this->_log( "reduce: reading reduce file [$reduce_file]" ) ;
|
|
my $fh = new FileHandle( $reduce_file ) or Carp::croak( "reduce: error: cannot open the reduce file [$reduce_file]: $!\n" ) ;
|
|
my $current_basename ;
|
|
while(<$fh>)
|
|
{
|
|
chomp( my $line = $_ ) ;
|
|
next if $line =~ m/^\s*$/ ;
|
|
next if $line =~ m/^#/ ;
|
|
my ( $r_basename , $r_sigline , $r_action , $r_sig ) = split( "\t" , $line ) ;
|
|
if( $r_basename ne $current_basename )
|
|
{
|
|
$current_basename = $r_basename ;
|
|
$this->{m_data}->{$r_basename} = {} ;
|
|
}
|
|
$this->_log( "reduce: [$r_basename] [$r_sig]" ) ;
|
|
$this->{m_data}->{$r_basename}->{$r_sig} = [$r_action,$r_sigline] ;
|
|
}
|
|
return $this ;
|
|
}
|
|
|
|
sub check
|
|
{
|
|
# Checks the source file for unused functions and accumulates the results
|
|
# for emit(). Optionally keeps the edits so that emit() and edit() are
|
|
# not needed.
|
|
my ( $this , $file_in , $keep_edits ) = @_ ;
|
|
|
|
my $basename = File::Basename::basename( $file_in ) ;
|
|
$this->{m_data}->{$basename} = {} ;
|
|
|
|
# make a working copy
|
|
my $current = "/tmp/reduce-$basename.tmp" ;
|
|
File::Copy::copy( $file_in , $current ) or Carp::croak( "reduce: error: cannot make a working copy of [$file_in]: $!" ) ;
|
|
|
|
# find all the functions
|
|
my @sigs = () ;
|
|
{
|
|
my $fh = new FileHandle( $current ) or die ;
|
|
my $fn = new Functions( $fh , sub { if($_[1]==1){push @sigs,[$_[0]->sigline(),$_[0]->sig()]} } ) ;
|
|
$fn->process() ;
|
|
$fh->close() ;
|
|
}
|
|
|
|
$this->_log( "reduce: $basename: found " , scalar(@sigs) , " function" , (scalar(@sigs)==1?"":"s") ) ;
|
|
|
|
# for each function...
|
|
my $remove_count = 0 ;
|
|
for my $sigpair ( @sigs )
|
|
{
|
|
my ( $sigline , $sig ) = @$sigpair ;
|
|
$this->_log( {start=>1} , "reduce: $basename($sigline): testing without "._namepad($sig,$sigline) ) ;
|
|
|
|
# disable the function -- write to $file_in (sic)
|
|
my $sigline_new = $this->_disable_function( $current , $file_in , $sig ) or die ;
|
|
if( !defined($sigline_new) ) { Carp::croak( "reduce: error: failed to comment-out [$sig]" ) }
|
|
|
|
# do the trial build
|
|
my $ok = $this->_build( sub{File::Copy::copy($current,$file_in)} ) ;
|
|
|
|
# record the result
|
|
if( $ok )
|
|
{
|
|
$this->_log( {end=>1} , ".. good build: remove fn (keep the edit)" ) ;
|
|
$remove_count++ ;
|
|
$this->{m_data}->{$basename}->{$sig} = ["remove",$sigline] ;
|
|
|
|
}
|
|
else
|
|
{
|
|
$this->_log( {end=>1} , ".. bad build: keep fn (revert the edit)" ) ;
|
|
$this->{m_data}->{$basename}->{$sig} = ["keep",$sigline] ;
|
|
}
|
|
|
|
# restore the file or keep the edits
|
|
if( $ok && $keep_edits )
|
|
{
|
|
File::Copy::copy( $file_in , $current ) or die ;
|
|
}
|
|
else
|
|
{
|
|
File::Copy::copy( $current , $file_in ) or die ;
|
|
}
|
|
}
|
|
unlink( $current ) ;
|
|
|
|
my $function_count = scalar(@sigs) ;
|
|
if( $function_count > 0 && $function_count == $remove_count )
|
|
{
|
|
print "reduce: $basename: warning: all functions removed\n" ;
|
|
return 0 ;
|
|
}
|
|
else
|
|
{
|
|
print "reduce: $basename: removed $remove_count/$function_count functions\n" ;
|
|
return 1 ;
|
|
}
|
|
}
|
|
|
|
sub _disable_function
|
|
{
|
|
my ( $this , $file_in , $file_out , $sig_to_edit ) = @_ ;
|
|
my $fh_in = new FileHandle( $file_in ) or die ;
|
|
my $fh_out = new FileHandle( $file_out , "w" ) or die ;
|
|
my $fn = new Functions( $fh_in , sub { _disable_function_callback($this,$sig_to_edit,$fh_out,@_) } ) ;
|
|
my $result = $fn->process() ;
|
|
$fh_in->close() or die ;
|
|
$fh_out->close() or die ;
|
|
return $result ;
|
|
}
|
|
|
|
sub _disable_function_callback
|
|
{
|
|
my ( $this , $sig_to_edit , $fh_out , $fn , $state , $line , $result_ref ) = @_ ;
|
|
if( $fn->sig() eq $sig_to_edit )
|
|
{
|
|
my $ifndef = $this->{m_ifndef} ;
|
|
my $endif = $this->{m_endif} ;
|
|
my $comment_out = $this->{m_comment_out} ;
|
|
|
|
if( $state == 0 )
|
|
{
|
|
print $fh_out $line , "\n" ;
|
|
}
|
|
elsif( $state == 1 )
|
|
{
|
|
$$result_ref = $fn->sigline() ;
|
|
print $fh_out $ifndef , "\n" if $ifndef ;
|
|
print $fh_out $comment_out , $line , "\n" ;
|
|
}
|
|
elsif( $state == 5 || $state == 33 )
|
|
{
|
|
print $fh_out $comment_out , $line , "\n" ;
|
|
print $fh_out $endif , "\n" if $endif ;
|
|
}
|
|
else
|
|
{
|
|
print $fh_out $comment_out , $line , "\n" ;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
print $fh_out $line , "\n" ;
|
|
}
|
|
}
|
|
|
|
sub _by_sigline
|
|
{
|
|
my ( $this , $basename , $sig1 , $sig2 ) = @_ ;
|
|
my ( $action1 , $sigline1 ) = @{$this->{m_data}->{$basename}->{$sig1}} ;
|
|
my ( $action2 , $sigline2 ) = @{$this->{m_data}->{$basename}->{$sig2}} ;
|
|
return $sigline1 <=> $sigline2 ;
|
|
}
|
|
|
|
sub emit
|
|
{
|
|
my ( $this , $fh_out ) = @_ ;
|
|
|
|
for my $basename ( sort keys %{$this->{m_data}} )
|
|
{
|
|
for my $sig ( sort {_by_sigline($this,$basename,$a,$b)} keys %{$this->{m_data}->{$basename}} )
|
|
{
|
|
my ( $action , $sigline ) = @{$this->{m_data}->{$basename}->{$sig}} ;
|
|
print $fh_out join("\t",$basename,$sigline,$action,$sig) , "\n" ;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub edit
|
|
{
|
|
# Edits the source file to comment-out unused functions as per the reduce file.
|
|
my ( $this , $file_in , $file_out , $basename ) = @_ ;
|
|
|
|
$basename ||= File::Basename::basename( $file_in ) ;
|
|
|
|
if( exists($this->{m_data}->{$basename}) )
|
|
{
|
|
$this->_log( "reduce: reducing [$basename]" ) ;
|
|
my $fh_in = new FileHandle( $file_in ) or Carp::confess( "cannot open input" ) ;
|
|
my $fh_out = new FileHandle( $file_out , "w" ) or Carp::confess( "cannot open output" ) ;
|
|
my $fn = new Functions( $fh_in , sub { $this->_edit_callback($basename,$fh_out,@_) } ) ;
|
|
my $result__ignored = $fn->process() ;
|
|
$fh_in->close() or die ;
|
|
$fh_out->close() or Carp::confess( "cannot write output" ) ;
|
|
return 1 ;
|
|
}
|
|
else
|
|
{
|
|
$this->_log( "reduce: no reduce record for [$basename]" ) ;
|
|
return 0 ;
|
|
}
|
|
}
|
|
|
|
sub _edit_callback
|
|
{
|
|
my ( $this , $basename , $fh_out , $fn , $state , $line , $result_ref ) = @_ ;
|
|
|
|
my $ifndef = $this->{m_ifndef} ;
|
|
my $endif = $this->{m_endif} ;
|
|
my $comment_out = $this->{m_comment_out} ;
|
|
|
|
my $sig = $fn->sig() ;
|
|
die if( $state > 0 && !defined($sig) ) ;
|
|
|
|
my $data = $this->{m_data}->{$basename} ;
|
|
my ( $action , $sigline ) = ( "" , 0 ) ;
|
|
if( $data && defined($sig) && $data->{$sig} )
|
|
{
|
|
( $action , $sigline ) = @{$data->{$sig}} ;
|
|
die unless ( $action eq "remove" || $action eq "keep" ) ;
|
|
}
|
|
|
|
if( $action eq "remove" )
|
|
{
|
|
if( $state == 0 )
|
|
{
|
|
print $fh_out $line , "\n" ;
|
|
}
|
|
elsif( $state == 1 )
|
|
{
|
|
$this->_debug( "reducing [$basename]: commenting-out [$sig]" ) ;
|
|
$$result_ref = $fn->sigline() ;
|
|
print $fh_out $ifndef , "\n" if $ifndef ;
|
|
print $fh_out $comment_out , $line , "\n" ;
|
|
}
|
|
elsif( $state == 5 || $state == 33 )
|
|
{
|
|
print $fh_out $comment_out , $line , "\n" ;
|
|
print $fh_out $endif , "\n" if $endif ;
|
|
}
|
|
else
|
|
{
|
|
print $fh_out $comment_out , $line , "\n" ;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
print $fh_out $line , "\n" ;
|
|
}
|
|
}
|
|
|
|
sub _build
|
|
{
|
|
my ( $this , $exit_fn ) = @_ ;
|
|
for my $make ( @{$this->{m_make_commands}} )
|
|
{
|
|
my $rc = $this->{m_debug} ? system( $make ) : system( "$make >/dev/null 2>/dev/null" ) ;
|
|
if( $? & 127 ) { &$exit_fn() if $exit_fn ; die "system() interrupted" } ;
|
|
if( $rc != 0 ) { return 0 }
|
|
}
|
|
return 1 ;
|
|
}
|
|
|
|
sub _namepad
|
|
{
|
|
my ( $sig , $sigline ) = @_ ;
|
|
my ( $n ) = ( $sig =~ m;([A-Za-z0-9_:]*)\(; ) ;
|
|
my $max = 30 ;
|
|
if( !$n ) { $n = substr( $sig , 0 , $max ) }
|
|
$n = substr( $n , 0 , $max ) ;
|
|
my $pad = '.' x ($max+5-(length($n)+length($sigline))) ;
|
|
return "[$n]$pad" ;
|
|
}
|
|
|
|
sub _log
|
|
{
|
|
my ( $this , @args ) = @_ ;
|
|
my $cfg = {} ;
|
|
if( ref($args[0]) ) { $cfg = shift @args }
|
|
|
|
if( $this->{m_verbose} )
|
|
{
|
|
print @args , ( $cfg->{start} ? "" : "\n" ) ;
|
|
}
|
|
}
|
|
|
|
sub _debug
|
|
{
|
|
}
|
|
|
|
1 ;
|