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  warn $_;
  21  chomp;
  22  for(`cat \Q$_\E 2>/dev/null`) {
  23     next if exists $exceptions{s/^\s+//r};
  24     next if /rm -rf/; # Could be an example from perlsec, e.g.
  25     next if /END\s*\{/; # Creating an END block creates SVs, obviously
  26     next if /^\s*(?:push|unshift)/;
  27     my $q = s/[\\']/sprintf "\\%02x", ord $&/gore
  28          =~ s/\0/'."\\0".'/grid;
  29     $prog = <<end;
  30             open oUt, ">&", STDOUT;
  31             open STDOUT, ">/dev/null";
  32             open STDIN, "</dev/null";
  33             open STDERR, ">/dev/null";
  34             \$unused_variable = '$q';
  35             eval \$unused_variable;
  36             print oUt sv_count, "\n";
  37             eval \$unused_variable;
  38             print oUt sv_count, "\n";
  39 end
  40     open my $fh, "-|", $^X, "-Ilib", "-MXS::APItest=sv_count",
  41                  '-e', $prog or warn($!), next;
  42     local $/;
  43     $out = <$fh>;
  44     close $fh;
  45     @_ = split ' ', $out;
  46     if (@_ == 2 && $_[1] > $_[0]) { print Dumper $_ }
  47  }
  48 }
  49
  50 BEGIN {
  51  @exceptions = split /^/, <<'end';
  52 do {$x[$x] = $x;} while ($x++) < 10;
  53 eval 'v23: $counter++; goto v23 unless $counter == 2';
  54 eval 'v23 : $counter++; goto v23 unless $counter == 2';
  55 my $select_ret = select($rout = $rin, undef, undef, $timeout);
  56 select(undef,undef,undef,$delay);
  57 end
  58  @exceptions{@exceptions} = ();
  59 }