This is 1.00

[perl/modules/Test-Valgrind.git] / Gensupp.PL

diff --git a/Gensupp.PL b/Gensupp.PL
deleted file mode 100755 (executable)
index 7fb875c..0000000
--- a/Gensupp.PL
+++ /dev/null
@@ -1,83 +0,0 @@
-use strict;
-use warnings;
-
-my ($sf) = @ARGV;
-exit 1 unless defined $sf;
-
-my $file = './gen.pl';
-
-pipe my $rdr, my $wtr or die "pipe(\$rdr, \$wtr): $!";
-my $pid = fork;
-if (!defined $pid) {
- die "fork(): $!";
-} elsif ($pid == 0) {
- close $rdr or die "close(\$rdr): $!";
- open STDERR, '>&', $wtr or die "open(STDERR, '>&', \$wtr): $!";
- exec $^X, '-Mlib=lib', $file;
-}
-close $wtr or die "close(\$rdr): $!";
-
-my ($s, $in, @supps) = ('', 0);
-while (<$rdr>) {
- s/^\s*#\s//;
- next if /^==/;
- next if /valgrind/ and /\Q$file\E/;
- 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 "{\n$name" . (++$num) . "\n$_}\n" for @supps;
-close $out;