This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
leakfinder.pl: Use DD for output
[perl5.git] / Porting / leakfinder.pl
1
2 # WARNING! This script can be dangerous.  It executes every line in every
3 # file in the build directory and its subdirectories, so it could do some
4 # harm if the line contains `rm *` or something similar.
5 #
6 # Run this as ./perl -Ilib Porting/leakfinder.pl after building perl.
7 #
8 # This is a quick non-portable hack that evaluates pieces of code in an
9 # eval twice and sees whether the number of SVs goes up.  Any lines that
10 # leak are printed to STDOUT.
11 #
12 # push and unshift will give false positives.  Some lines (listed at the
13 # bottom) are explicitly skipped.  Some patterns (at the beginning of the
14 # inner for loop) are also skipped.
15
16 use XS::APItest "sv_count";
17 use Data::Dumper;
18 $Data::Dumper::Useqq++;
19 for(`find .`) {
20  chomp;
21  for(`cat \Q$_\E 2>/dev/null`) {
22     next if exists $exceptions{$_};
23     next if /rm -rf/; # Could be an example from perlsec, e.g.
24     next if /END \{/; # Creating an END block creates SVs, obviously
25     my $q = s/[\\']/sprintf "\\%02x", ord $&/gore
26          =~ s/\0/'."\\0".'/grid;
27     $prog = <<end;   
28             open oUt, ">&", STDOUT;
29             open STDOUT, ">/dev/null";
30             open STDIN, "</dev/null";
31             open STDERR, ">/dev/null";
32             \$unused_variable = '$q';
33             eval \$unused_variable;
34             print oUt sv_count, "\n";
35             eval \$unused_variable;
36             print oUt sv_count, "\n";
37 end
38     open my $fh, "-|", $^X, "-Ilib", "-MXS::APItest=sv_count",
39                  '-e', $prog or warn($!), next;
40     local $/;
41     $out = <$fh>;
42     close $fh;
43     @_ = split ' ', $out;
44     if (@_ == 2 && $_[1] > $_[0]) { print Dumper $_ }
45  }
46 }
47
48 BEGIN {
49  @exceptions = split /^/, <<'end';
50 do {$x[$x] = $x;} while ($x++) < 10;
51 eval 'v23: $counter++; goto v23 unless $counter == 2';
52 eval 'v23 : $counter++; goto v23 unless $counter == 2';
53 END { unlink "./foo"; }
54 exit 1;
55         push @a, \$x;
56     unshift @INC, "../lib";
57 end
58  @exceptions{@exceptions} = ();
59 }