Generate extra suppressions and remove duplicated ones

diff --git a/Gensupp.PL b/Gensupp.PL
index 024efeec3ffeca6959a57ee42be26fa915d4ac4c..7fb875c65907d164e536f3c7ac082f1fa709ab3b 100755 (executable)
--- 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;