This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
leakfinder.pl: Skip push/unshift after { or (
[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;
2339cd98 62A rare race condition that would lead to L<sleep|perlfunc/sleep> taking more
4e532ee7
FC
63$args{include_dirs} = [ $args{include_dirs} ]
64$ARRAY[++$#ARRAY] = $value;
2339cd98 65@a = sort ($b, @a)
4e532ee7
FC
66$a = {x => $a};
67BEGIN { unshift(@INC, "./blib") }
2339cd98
FC
68BEGIN { unshift @INC, "lib" }
69BEGIN { unshift(@INC, LIST) }
4e532ee7
FC
70binmode *STDERR, ":encoding(utf8)";
71binmode *STDOUT, ":encoding(utf8)";
867b16b5 72char const *file = __FILE__;
f59c2126 73$char++ while substr( $got, $char, 1 ) eq substr( $wanted, $char, 1 );
4e532ee7 74CHECK { $main::phase++ }
f432c75f 75$config{$k} = [ $config{$k} ]
2339cd98 76const char *file = __FILE__;
4e532ee7 77const char* file = __FILE__;
867b16b5
FC
78$count4 = unshift (@array, 0);
79$count7 = unshift (@array, 3, 2, 1);
4e532ee7
FC
80$data = [ $data ];
81do { $tainted_value = shift @ENV_values } while(!$tainted_value || ref $tainted_value);
8b3001cd 82do {$x[$x] = $x;} while ($x++) < 10;
867b16b5
FC
83eval {CHECK {print ":c3"}};
84eval {INIT {print ":i2"}};
85eval { $proto->can($method) } || push @nok, $method
86eval { push \@ISA, __FILE__ };
8b3001cd
FC
87eval 'v23: $counter++; goto v23 unless $counter == 2';
88eval 'v23 : $counter++; goto v23 unless $counter == 2';
4e532ee7 89$formdata->{$key} = [ $formdata->{$key}, $value ];
2339cd98 90$func = $next{$func} until $pod{$func};
4e532ee7 91$got_arrayref ? unshift(@{$args[0]}, $cmd) : unshift(@args, $cmd);
2339cd98 92$h{ []} = 123;
4e532ee7 93{ $h[++$i] = $_ }
2339cd98 94High resolution alarm, sleep, gettimeofday, interval timers
4e532ee7 95$i = int($i/2) until defined $self->[$i/2];
f432c75f 96$invmap_ref->[$i] = [ $invmap_ref->[$i] ];
867b16b5
FC
97is(push(@ary,4), 3);
98is(push(@ary,56), 4);
99is(unshift(@ary,12), 5);
4e532ee7 100$i++ while $self->{ids}{"$t$i"}++;
867b16b5 101{ --$level; push @out, (" " x $level) . "</ul>"; }
4e532ee7 102$mod_hash->{$k} = [ $mod_hash->{$k} ];
867b16b5
FC
103$modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
104my $deep1 = []; push @$deep1, $deep1;
105my $deep2 = []; push @$deep2, $deep2;
4e532ee7
FC
106my $nfound = select($_[0], $_[1], $_[2], $_[3]);
107my $nfound = select($_[0], $_[1], $_[2], $gran);
867b16b5 108my $n = unshift(@ary,5,6);
4e532ee7
FC
109my @result = splice @temp, $self, $offset, $length, @_;
110my @r = splice @a, 0, 1, "x", "y";
111$_ = {name=>$_};
112$n = push @a, "rec0", "rec1", "rec2";
113$n = push @a, "rec3", "rec4$:";
114$n = unshift @a, "rec0", "rec1", "rec2";
115$n = unshift @a, "rec3", "rec4$:";
fdf1a925 116@$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
4e532ee7 117@old = splice(@h, 1, 2, qw(bananas just before));
867b16b5 118unlink <"$filename*">;
4e532ee7
FC
119package XS::APItest; require XSLoader; XSLoader::load()
120$pa = { -exitval => $pa };
121$pa = { -message => $pa };
122pop @lines while $lines[-1] eq "";
123pop @to while $#to and $to[$#to] == $to[$#to -1];
867b16b5
FC
124pop(@$x); unshift(@q, $q);
125@prgs = (@prgs, $file, split "\n########\n", <$fh>) ;
2339cd98 126print "LA LA LA\n" while 1; # loops forever
4e532ee7
FC
127prog => 'use Config; CHECK { $Config{awk} }',
128$p->{share_dir} = { dist => [ $p->{share_dir} ] };
129$p->{share_dir} = { dist => $p->{share_dir} };
4e532ee7 130$resp = [$resp]
867b16b5 131s/a|/push @bar, 1/e;
4e532ee7
FC
132$self->{DIR} = [grep $_, split ":", $self->{DIR}];
133$share_dir->{dist} = [ $share_dir->{dist} ];
fdf1a925 134s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,#_;END{print"@m"}'
4e532ee7 135$spec = [$spec, $_[0]];
867b16b5 136*s = ~(*s);
f432c75f 137$stack[$i++] &= ~1;
4e532ee7 138$step = [$step];
867b16b5
FC
139sub CHECK {print ":check"}
140sub INIT {print ":init"}
2339cd98 141system("find . -type f -print | xargs chmod 0444");
b64eceeb 142the while clause. */
4e532ee7 143Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
b64eceeb
FC
144*tmpl = ~*tmpl;
145*tmps = ~*tmps;
867b16b5 146until ($i) { }
4e532ee7
FC
147weaken($objs[@objs] = $h{$_} = []);
148weaken($objs[@objs] = $$h{$_} = []);
149while (1) { my $k; }
150while(1) { sleep(1); }
2339cd98 151while($foo--) { print("In thread $thread\n"); }
867b16b5
FC
152"words" =~ /(word|word|word)(?{push \@got, $1})s$/;
153"words" =~ /(word|word|word)(?{push \@got,$1})s$/i;
4e532ee7
FC
154$x->[$j] -= $BASE if $car = (($x->[$j] += $car) >= $BASE) ? 1 : 0; $j++;
155$x->[scalar @$x] = 0; # avoid || 0 test inside loop
156$z = splice @a, 3, 1, "recordZ";
8b3001cd
FC
157end
158 @exceptions{@exceptions} = ();
159}