This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
leakfinder.pl: exceptions
[perl5.git] / Porting / leakfinder.pl
CommitLineData
8b3001cd
FC
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
16use XS::APItest "sv_count";
3ad265de
FC
17use Data::Dumper;
18$Data::Dumper::Useqq++;
8b3001cd 19for(`find .`) {
6aad22ca 20 warn $_;
8b3001cd
FC
21 chomp;
22 for(`cat \Q$_\E 2>/dev/null`) {
6a95d59f 23 next if exists $exceptions{s/^\s+//r};
8b3001cd 24 next if /rm -rf/; # Could be an example from perlsec, e.g.
2339cd98
FC
25 # Creating one of these special blocks creates SVs, obviously
26 next if /(?:END|CHECK|INIT)\s*\{/;
632738b3 27 next if /^[{(]?\s*(?:push|unshift|(?:\@r = )?splice|binmode|sleep)/;
fe04edcb 28 next if /\bselect(?:\s*|\()[^()]+,/; # 4-arg select hangs
867b16b5 29 next if /use parent/;
3ad265de
FC
30 my $q = s/[\\']/sprintf "\\%02x", ord $&/gore
31 =~ s/\0/'."\\0".'/grid;
8b3001cd
FC
32 $prog = <<end;
33 open oUt, ">&", STDOUT;
34 open STDOUT, ">/dev/null";
35 open STDIN, "</dev/null";
36 open STDERR, ">/dev/null";
3ad265de 37 \$unused_variable = '$q';
39fa595e 38 eval \$unused_variable while \$also_unused++ < 4;
8b3001cd
FC
39 print oUt sv_count, "\n";
40 eval \$unused_variable;
41 print oUt sv_count, "\n";
42end
43 open my $fh, "-|", $^X, "-Ilib", "-MXS::APItest=sv_count",
44 '-e', $prog or warn($!), next;
45 local $/;
46 $out = <$fh>;
47 close $fh;
48 @_ = split ' ', $out;
3ad265de 49 if (@_ == 2 && $_[1] > $_[0]) { print Dumper $_ }
8b3001cd
FC
50 }
51}
52
53BEGIN {
54 @exceptions = split /^/, <<'end';
867b16b5 551 while 1;
b64eceeb
FC
561 while some_condition_with_side_effects; */
57$a{buttons}[2*$a{default_button}] = [$a{buttons}[2*$a{default_button}]];
19e50f26
FC
58$aliases{$code_point} = [ $aliases{$code_point} ];
59$aliases_maps->[$i] = [ $aliases_maps->[$i] ]
4e532ee7 60$allow ? $hash{$acc} = $allow : push @list, $acc;
867b16b5 61/(a*(*MARK:a)b?)(*MARK:x)(*SKIP:a)(?{$count++; push @res,$1})(*FAIL)/g;
61b476f9 62$^A .= new version ~$_ for "\xce", v205, "\xcc";
2339cd98 63A rare race condition that would lead to L<sleep|perlfunc/sleep> taking more
4e532ee7
FC
64$args{include_dirs} = [ $args{include_dirs} ]
65$ARRAY[++$#ARRAY] = $value;
2339cd98 66@a = sort ($b, @a)
4e532ee7 67$a = {x => $a};
61b476f9
FC
68$base =~ /^[cwnv]/i or push @tmpl, "$base>", "$base<";
69$base =~ /^[nv]/i or push @formats, "$base>", "$base<";
4e532ee7 70BEGIN { unshift(@INC, "./blib") }
2339cd98
FC
71BEGIN { unshift @INC, "lib" }
72BEGIN { unshift(@INC, LIST) }
4e532ee7
FC
73binmode *STDERR, ":encoding(utf8)";
74binmode *STDOUT, ":encoding(utf8)";
867b16b5 75char const *file = __FILE__;
f59c2126 76$char++ while substr( $got, $char, 1 ) eq substr( $wanted, $char, 1 );
4e532ee7 77CHECK { $main::phase++ }
f432c75f 78$config{$k} = [ $config{$k} ]
2339cd98 79const char *file = __FILE__;
4e532ee7 80const char* file = __FILE__;
867b16b5
FC
81$count4 = unshift (@array, 0);
82$count7 = unshift (@array, 3, 2, 1);
4e532ee7
FC
83$data = [ $data ];
84do { $tainted_value = shift @ENV_values } while(!$tainted_value || ref $tainted_value);
8b3001cd 85do {$x[$x] = $x;} while ($x++) < 10;
867b16b5
FC
86eval {CHECK {print ":c3"}};
87eval {INIT {print ":i2"}};
61b476f9 88eval { $proto->can($method) } || push @nok, $method;
867b16b5 89eval { push \@ISA, __FILE__ };
8b3001cd
FC
90eval 'v23: $counter++; goto v23 unless $counter == 2';
91eval 'v23 : $counter++; goto v23 unless $counter == 2';
4e532ee7 92$formdata->{$key} = [ $formdata->{$key}, $value ];
2339cd98 93$func = $next{$func} until $pod{$func};
4e532ee7 94$got_arrayref ? unshift(@{$args[0]}, $cmd) : unshift(@args, $cmd);
2339cd98 95$h{ []} = 123;
4e532ee7 96{ $h[++$i] = $_ }
2339cd98 97High resolution alarm, sleep, gettimeofday, interval timers
1b304fad 98if (-d "$directory/$_") { push @ARGV, "$directory/$_" }
4e532ee7 99$i = int($i/2) until defined $self->[$i/2];
f432c75f 100$invmap_ref->[$i] = [ $invmap_ref->[$i] ];
867b16b5
FC
101is(push(@ary,4), 3);
102is(push(@ary,56), 4);
103is(unshift(@ary,12), 5);
4e532ee7 104$i++ while $self->{ids}{"$t$i"}++;
867b16b5 105{ --$level; push @out, (" " x $level) . "</ul>"; }
4e532ee7 106$mod_hash->{$k} = [ $mod_hash->{$k} ];
867b16b5
FC
107$modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
108my $deep1 = []; push @$deep1, $deep1;
109my $deep2 = []; push @$deep2, $deep2;
4e532ee7
FC
110my $nfound = select($_[0], $_[1], $_[2], $_[3]);
111my $nfound = select($_[0], $_[1], $_[2], $gran);
867b16b5 112my $n = unshift(@ary,5,6);
4e532ee7
FC
113my @result = splice @temp, $self, $offset, $length, @_;
114my @r = splice @a, 0, 1, "x", "y";
115$_ = {name=>$_};
116$n = push @a, "rec0", "rec1", "rec2";
117$n = push @a, "rec3", "rec4$:";
118$n = unshift @a, "rec0", "rec1", "rec2";
119$n = unshift @a, "rec3", "rec4$:";
fdf1a925 120@$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
4e532ee7 121@old = splice(@h, 1, 2, qw(bananas just before));
867b16b5 122unlink <"$filename*">;
4e532ee7
FC
123package XS::APItest; require XSLoader; XSLoader::load()
124$pa = { -exitval => $pa };
125$pa = { -message => $pa };
126pop @lines while $lines[-1] eq "";
127pop @to while $#to and $to[$#to] == $to[$#to -1];
867b16b5
FC
128pop(@$x); unshift(@q, $q);
129@prgs = (@prgs, $file, split "\n########\n", <$fh>) ;
2339cd98 130print "LA LA LA\n" while 1; # loops forever
4e532ee7
FC
131prog => 'use Config; CHECK { $Config{awk} }',
132$p->{share_dir} = { dist => [ $p->{share_dir} ] };
133$p->{share_dir} = { dist => $p->{share_dir} };
1b304fad 134-sleep
4e532ee7 135$resp = [$resp]
61b476f9
FC
136$r = eval q[ qr/$r(??{$x})/; ];
137$r = qr/$r(??{$x})/;
867b16b5 138s/a|/push @bar, 1/e;
4e532ee7
FC
139$self->{DIR} = [grep $_, split ":", $self->{DIR}];
140$share_dir->{dist} = [ $share_dir->{dist} ];
fdf1a925 141s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,#_;END{print"@m"}'
4e532ee7 142$spec = [$spec, $_[0]];
867b16b5 143*s = ~(*s);
f432c75f 144$stack[$i++] &= ~1;
4e532ee7 145$step = [$step];
867b16b5
FC
146sub CHECK {print ":check"}
147sub INIT {print ":init"}
2339cd98 148system("find . -type f -print | xargs chmod 0444");
b64eceeb 149the while clause. */
4e532ee7 150Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
b64eceeb
FC
151*tmpl = ~*tmpl;
152*tmps = ~*tmps;
867b16b5 153until ($i) { }
4e532ee7
FC
154weaken($objs[@objs] = $h{$_} = []);
155weaken($objs[@objs] = $$h{$_} = []);
156while (1) { my $k; }
157while(1) { sleep(1); }
2339cd98 158while($foo--) { print("In thread $thread\n"); }
61b476f9
FC
159"words" =~ /(word|word|word)(?{push @got, $1})s$/;
160"words" =~ /(word|word|word)(?{push @got,$1})s$/i;
4e532ee7
FC
161$x->[$j] -= $BASE if $car = (($x->[$j] += $car) >= $BASE) ? 1 : 0; $j++;
162$x->[scalar @$x] = 0; # avoid || 0 test inside loop
163$z = splice @a, 3, 1, "recordZ";
8b3001cd
FC
164end
165 @exceptions{@exceptions} = ();
166}