5 exit 1 unless defined $sf;
9 pipe my $rdr, my $wtr or die "pipe(\$rdr, \$wtr): $!";
14 close $rdr or die "close(\$rdr): $!";
15 open STDERR, '>&', $wtr or die "open(STDERR, '>&', \$wtr): $!";
16 exec $^X, '-Mlib=lib', $file;
18 close $wtr or die "close(\$rdr): $!";
20 my ($s, $in, @supps) = ('', 0);
24 next if /valgrind/ and /\Q$file\E/;
44 print "Found $a suppressions\n";
48 if (/\bfun:(m|c|re)alloc\b/) {
51 if ($t eq 'm') { # malloc can also be called by calloc or realloc
52 $call{$_} = 1 for qw/calloc realloc/;
53 } elsif ($t eq 're') { # realloc can also call malloc or free
54 $call{$_} = 0 for qw/malloc free/;
55 } elsif ($t eq 'c') { # calloc can also call malloc
56 $call{$_} = 0 for qw/malloc/;
61 $d =~ s/\b(fun:${t}alloc)\b/$call{$_} ? "$1\nfun:$_" : "fun:$_\n$1"/e;
62 # Remove one line for each line added or valgrind will hate us
63 $d =~ s/\n(.+?)\s*$/\n/;
69 print "Generated $e extra suppressions\n";
72 @dupes{@supps, @extra} = ();
75 print "Removed " . (($a + $e) - $b) . " duplicates\n";
77 my ($name, $num) = ('perlTestValgrind', 0);
81 open my $out, '>', $sf or die "$!";
82 print $out "{\n$name" . (++$num) . "\n$_}\n" for @supps;