leakfinder.pl

I wrote this to look for memory leaks.  Since it could be useful to
re-run it at some future time, I might as well put it somewhere where
it will not get lost.

It still needs a bit of work.  Currently, evaluating chunks of binary
code can cause memory leaks.  In those cases the binary code is dumped
straight to the terminal, which is not helpful.

diff --git a/MANIFEST b/MANIFEST
index 9d857ef..69cb28e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4815,6 +4815,7 @@ Porting/git-make-p4-refs  Output git refs for each p4 change number, suitable for
 Porting/GitUtils.pm            Generate the contents of a .patch file
 Porting/Glossary               Glossary of config.sh variables
 Porting/how_to_write_a_perldelta.pod   Bluffer's guide to writing a perldelta.
+Porting/leakfinder.pl          Hacky script for finding memory leaks
 Porting/Maintainers            Program to pretty print info in Maintainers.pl
 Porting/Maintainers.pl         Information about maintainers
 Porting/Maintainers.pm         Library to pretty print info in Maintainers.pl

diff --git a/Porting/leakfinder.pl b/Porting/leakfinder.pl
new file mode 100644 (file)
index 0000000..4272bb3
--- /dev/null
+++ b/Porting/leakfinder.pl
@@ -0,0 +1,57 @@
+
+# WARNING! This script can be dangerous.  It executes every line in every
+# file in the build directory and its subdirectories, so it could do some
+# harm if the line contains `rm *` or something similar.
+#
+# Run this as ./perl -Ilib Porting/leakfinder.pl after building perl.
+#
+# This is a quick non-portable hack that evaluates pieces of code in an
+# eval twice and sees whether the number of SVs goes up.  Any lines that
+# leak are printed to STDOUT.
+#
+# push and unshift will give false positives.  Some lines (listed at the
+# bottom) are explicitly skipped.  Some patterns (at the beginning of the
+# inner for loop) are also skipped.
+
+use XS::APItest "sv_count";
+for(`find .`) {
+ chomp;
+ for(`cat \Q$_\E 2>/dev/null`) {
+    next if exists $exceptions{$_};
+    next if /rm -rf/; # Could be an example from perlsec, e.g.
+    next if /END \{/; # Creating an END block creates SVs, obviously
+    s/[\\']/sprintf "\\%02x", ord $&/egg;
+    s/\0/'."\\0".'/g;
+    $prog = <<end;   
+            open oUt, ">&", STDOUT;
+            open STDOUT, ">/dev/null";
+            open STDIN, "</dev/null";
+            open STDERR, ">/dev/null";
+            \$unused_variable = '$_';
+            eval \$unused_variable;
+            print oUt sv_count, "\n";
+            eval \$unused_variable;
+            print oUt sv_count, "\n";
+end
+    open my $fh, "-|", $^X, "-Ilib", "-MXS::APItest=sv_count",
+                 '-e', $prog or warn($!), next;
+    local $/;
+    $out = <$fh>;
+    close $fh;
+    @_ = split ' ', $out;
+    if (@_ == 2 && $_[1] > $_[0]) { print $_ }
+ }
+}
+
+BEGIN {
+ @exceptions = split /^/, <<'end';
+do {$x[$x] = $x;} while ($x++) < 10;
+eval 'v23: $counter++; goto v23 unless $counter == 2';
+eval 'v23 : $counter++; goto v23 unless $counter == 2';
+END { unlink "./foo"; }
+exit 1;
+        push @a, \$x;
+    unshift @INC, "../lib";
+end
+ @exceptions{@exceptions} = ();
+}