[project @ fpeters@0d.be-20080217115557-8qtcrc1vzb75f75c]

merged Benjamin branch


Original author: Frederic Peters <fpeters@0d.be>
Date: 2008-02-17 12:55:57.088000+01:00

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.*/);
+}
+