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