From: Vincent Pit <vince@profvince.com>
Date: Mon, 25 Aug 2008 16:46:46 +0000 (+0200)
Subject: Generate extra suppressions and remove duplicated ones
X-Git-Tag: v0.05~7
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=db13282b745dfe28c52272c092ff4b9be81fc487;p=perl%2Fmodules%2FTest-Valgrind.git

Generate extra suppressions and remove duplicated ones
---

diff --git a/Gensupp.PL b/Gensupp.PL
index 024efee..7fb875c 100755
--- a/Gensupp.PL
+++ b/Gensupp.PL
@@ -17,17 +17,67 @@ if (!defined $pid) {
 }
 close $wtr or die "close(\$rdr): $!";
 
-my ($supp, $name, $num) = ('', 'perlTestValgrind', 0);
+my ($s, $in, @supps) = ('', 0);
 while (<$rdr>) {
  s/^\s*#\s//;
  next if /^==/;
  next if /valgrind/ and /\Q$file\E/;
- s/<[^>]+>/$name . ++$num/e;
- $supp .= $_;
+ s/^\s*//;
+ s/<[^>]+>//;
+ s/\s*$//;
+ next unless length;
+ if ($_ eq '{') {
+  $in = 1;
+ } elsif ($_ eq '}') {
+  push @supps, $s;
+  $s  = '';
+  $in = 0;
+ } elsif ($in) {
+  $s .= "$_\n";
+ }
 }
 waitpid $pid, 0;
 
+select STDERR;
+
+my $a = @supps;
+print "Found $a suppressions\n";
+
+my @extra;
+for (@supps) {
+ if (/\bfun:(m|c|re)alloc\b/) {
+  my $t = $1;
+  my %call;
+  if ($t eq 'm') { # malloc can also be called by calloc or realloc
+   $call{$_} = 1 for qw/calloc realloc/;
+  } elsif ($t eq 're') { # realloc can also call malloc or free
+   $call{$_} = 0 for qw/malloc free/;
+  } elsif ($t eq 'c') { # calloc can also call malloc
+   $call{$_} = 0 for qw/malloc/;
+  }
+  my $c = $_;
+  for (keys %call) {
+   my $d = $c;
+   $d =~ s/\b(fun:${t}alloc)\b/$call{$_} ? "$1\nfun:$_" : "fun:$_\n$1"/e;
+   # Remove one line for each line added or valgrind will hate us
+   $d =~ s/\n(.+?)\s*$/\n/;
+   push @extra, $d;
+  }
+ }
+}
+my $e = @extra;
+print "Generated $e extra suppressions\n";
+
+my %dupes;
+@dupes{@supps, @extra} = ();
+@supps = keys %dupes;
+my $b = @supps;
+print "Removed " . (($a + $e) - $b) . " duplicates\n";
+
+my ($name, $num) = ('perlTestValgrind', 0);
+
 1 while unlink $sf;
+
 open my $out, '>', $sf or die "$!";
-print $out $supp;
+print $out "{\n$name" . (++$num) . "\n$_}\n" for @supps;
 close $out;