diff options
Diffstat (limited to 'bindings/utility-scripts/error-analyzer.pl')
-rw-r--r-- | bindings/utility-scripts/error-analyzer.pl | 147 |
1 files changed, 147 insertions, 0 deletions
diff --git a/bindings/utility-scripts/error-analyzer.pl b/bindings/utility-scripts/error-analyzer.pl new file mode 100644 index 00000000..60b91c1f --- /dev/null +++ b/bindings/utility-scripts/error-analyzer.pl @@ -0,0 +1,147 @@ +#! /usr/bin/perl -w + eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' + if 0; #$running_under_some_shell + +use strict; +use File::Find (); +use Data::Dumper; + +# Set the variable $File::Find::dont_use_nlink if you're using AFS, +# since AFS cheats. + +# for the convenience of &wanted calls, including -eval statements: +use vars qw/*name *dir *prune/; +*name = *File::Find::name; +*dir = *File::Find::dir; +*prune = *File::Find::prune; + +sub wanted; + +sub unique { + my @in = @_; + my @ret = (); + + for my $x (@in) { + push @ret, $x if (! grep /$x/, @ret); + } + return @ret; +} + +my $functions = {}; + +my $p = $ARGV[0]; + +# Traverse desired filesystems +-d $p && File::Find::find({wanted => \&wanted}, $p); + +foreach my $function (keys %$functions) { + potential_errors($function); +} + +foreach my $name (sort (keys %$functions)) { + my $record = $functions->{$name}; + next if $record->{'return-type'} !~ /\bg?int\b/ || $record->{'return-type'} =~ /\bstatic\b/; + my @derr = @{$record->{'errors'}}; + my @inherr = @{$record->{'inherited-errors'}[0]}; + my $path = $record->{'file'}; + print "$name "; + my %temp = (); + @temp{@inherr} = (); + for (@derr) { + delete $temp{$_}; + print "$_ "; + } + if (keys %temp) { + foreach (keys %temp) { + print "$_ "; + } + } + print "\n"; +} + +exit; + +sub potential_errors { + my $function = shift; + + + return ([],[[],[]]) if ! exists $functions->{$function}; + my $record = $functions->{$function}; + + return ([],[[],[]]) if $record->{'return-type'} !~ /\bg?int\b/ || $record->{'recursing'}; + + if (! exists $record->{'inherited-errors'}) { + my @inheritederrors; + my @froms; + $record->{'recursing'} = 1; + + foreach my $call (@{$record->{'calls'}}) { + my ($err,$inh) = potential_errors($call); + my ($suberr,$subfrom) = @$inh; + + if (@$err || @$suberr) { + push @froms, $call; + push @inheritederrors, (@$err, @$suberr); + } + } + $record->{'inherited-errors'} = [[ unique(@inheritederrors) ],[@froms]]; + delete $record->{'recursing'}; + } + return ($record->{'errors'},$record->{'inherited-errors'}); +} + + +sub parse_file { + my $file = shift; + my $path = shift; + my $lastline; + my $curfunction; + my $curtype; + my @curerrors; + my @curcalls; + my $infunction = 0; + open FD, "<$file"; + while (<FD>) { + + MATCHING: { + if ($infunction) { + if (/^\}/) { + #print "finished funcctions $curfunction\n"; + $functions->{$curfunction} = { name => $curfunction, 'return-type' => $curtype, 'errors' => [ unique(@curerrors) ], 'calls' => [ @curcalls], 'file' => $path}; + $infunction = 0; + last MATCHING; + } + while (/(?:\breturn\b|=).*?([A-Za-z_]+)\(/g) { + push @curcalls, $1; + } + pos = 0; + while (/(LASSO_[A-Z_]*_ERROR_[A-Z_]*|LASSO_ERROR_[A-Z_]*)/g) { + push @curerrors, $1; + } + last MATCHING; + } + if (/^([a-z_]+)\([^;]*$/) { + $curfunction = $1; + chop $lastline; + $curtype = $lastline; + @curerrors = (); + @curcalls = (); + last MATCHING; + } + if ($curfunction && /^\{/) { + $infunction = 1; + last MATCHING; + } + } + $lastline = $_; + + } + close FD; +} + +sub wanted { + my ($dev,$ino,$mode,$nlink,$uid,$gid); + + parse_file($_,$File::Find::name) if ($_ =~ /^.*\.c$/s && $File::Find::name !~ /^.*\.svn.*/); +} + |