X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/e453bc07684ace67df27b778404869878e377144..7db8c4f1f19e6f855107ec990507a1a9cb0f59a6:/Porting/leakfinder.pl

diff --git a/Porting/leakfinder.pl b/Porting/leakfinder.pl
index 0d43173..c22a58e 100644
--- a/Porting/leakfinder.pl
+++ b/Porting/leakfinder.pl
@@ -20,9 +20,13 @@ for(`find .`) {
  warn $_;
  chomp;
  for(`cat \Q$_\E 2>/dev/null`) {
-    next if exists $exceptions{$_};
+    next if exists $exceptions{s/^\s+//r};
     next if /rm -rf/; # Could be an example from perlsec, e.g.
-    next if /END\s*\{/; # Creating an END block creates SVs, obviously
+     # Creating one of these special blocks creates SVs, obviously
+    next if /(?:END|CHECK|INIT)\s*\{/;
+    next if /^[{(]?\s*(?:push|unshift|(?:\@r = )?splice|binmode|sleep)/;
+    next if /\bselect(?:\s*|\()[^()]+,/; # 4-arg select hangs
+    next if /use parent/;
     my $q = s/[\\']/sprintf "\\%02x", ord $&/gore
          =~ s/\0/'."\\0".'/grid;
     $prog = <<end;   
@@ -31,7 +35,7 @@ for(`find .`) {
             open STDIN, "</dev/null";
             open STDERR, ">/dev/null";
             \$unused_variable = '$q';
-            eval \$unused_variable;
+            eval \$unused_variable while \$also_unused++ < 4;
             print oUt sv_count, "\n";
             eval \$unused_variable;
             print oUt sv_count, "\n";
@@ -48,22 +52,115 @@ end
 
 BEGIN {
  @exceptions = split /^/, <<'end';
+1 while 1;
+1 while some_condition_with_side_effects;  */
+$a{buttons}[2*$a{default_button}] = [$a{buttons}[2*$a{default_button}]];
+$aliases{$code_point} = [ $aliases{$code_point} ];
+$aliases_maps->[$i] = [ $aliases_maps->[$i] ]
+$allow ? $hash{$acc} = $allow : push @list, $acc;
+/(a*(*MARK:a)b?)(*MARK:x)(*SKIP:a)(?{$count++; push @res,$1})(*FAIL)/g;
+$^A .= new version ~$_ for "\xce", v205, "\xcc";
+A rare race condition that would lead to L<sleep|perlfunc/sleep> taking more
+$args{include_dirs} = [ $args{include_dirs} ] 
+$ARRAY[++$#ARRAY] = $value;
+@a = sort ($b, @a)
+$a = {x => $a};
+$base =~ /^[cwnv]/i or push @tmpl, "$base>", "$base<";
+$base =~ /^[nv]/i or push @formats, "$base>", "$base<";
+BEGIN { unshift(@INC, "./blib") }
+BEGIN { unshift @INC, "lib" }
+BEGIN { unshift(@INC, LIST) }
+binmode *STDERR, ":encoding(utf8)";
+binmode *STDOUT, ":encoding(utf8)";
+char const *file = __FILE__;
+$char++ while substr( $got, $char, 1 ) eq substr( $wanted, $char, 1 );
+CHECK { $main::phase++ }
+$config{$k} = [ $config{$k} ]
+const char *file = __FILE__;
+const char* file = __FILE__;
+$count4 = unshift (@array, 0);
+$count7 = unshift (@array, 3, 2, 1);
+$data = [ $data ];
+do { $tainted_value = shift @ENV_values  } while(!$tainted_value || ref $tainted_value);
 do {$x[$x] = $x;} while ($x++) < 10;
+eval {CHECK {print ":c3"}};
+eval {INIT {print ":i2"}};
+eval { $proto->can($method) } || push @nok, $method;
+eval { push \@ISA, __FILE__ };
 eval 'v23: $counter++; goto v23 unless $counter == 2';
 eval 'v23 : $counter++; goto v23 unless $counter == 2';
-END { unlink "./foo"; }
-exit 1;
-    my $select_ret = select($rout = $rin, undef, undef, $timeout);
-        push @a, \$x;
-	push(@non_v, "#$_"); # not a name='value' line
-	    push @v_others, "CONFIG='$v'\n";
-    push(@v_others, $line);
-	    push @v_others, "PATCHLEVEL='$v'\n";
-	    push @v_others, "SUBVERSION='$v'\n";
-        select(undef,undef,undef,$delay);
-    unshift @INC, "../lib";
-	    unshift(@inc_version_list, grep { -d } $d->[0]."/$archname", $d->[0]);
-  unshift(@INC,"xlib/$Opts{cross}");
+$formdata->{$key} = [ $formdata->{$key}, $value ];
+$func = $next{$func} until $pod{$func};
+$got_arrayref ? unshift(@{$args[0]}, $cmd) : unshift(@args, $cmd);
+$h{ []} = 123;
+{ $h[++$i] = $_ }
+High resolution alarm, sleep, gettimeofday, interval timers
+if (-d "$directory/$_") { push    @ARGV, "$directory/$_" }
+$i = int($i/2) until defined $self->[$i/2];
+$invmap_ref->[$i] = [ $invmap_ref->[$i] ];
+is(push(@ary,4), 3);
+is(push(@ary,56), 4);
+is(unshift(@ary,12), 5);
+$i++ while $self->{ids}{"$t$i"}++;
+{ --$level; push @out, ("  " x $level) . "</ul>"; }
+$mod_hash->{$k} = [ $mod_hash->{$k} ];
+$modlibname =~ s,[\\/][^\\/]+$,, while $c--;    # Q&D basename
+my $deep1 = []; push @$deep1, $deep1;
+my $deep2 = []; push @$deep2, $deep2;
+my $nfound = select($_[0], $_[1], $_[2], $_[3]);
+my $nfound = select($_[0], $_[1], $_[2], $gran);
+my $n = unshift(@ary,5,6);
+my @result = splice @temp, $self, $offset, $length, @_;
+my @r = splice @a, 0, 1, "x", "y";
+$_ = {name=>$_};
+$n = push @a, "rec0", "rec1", "rec2";
+$n = push @a, "rec3", "rec4$:";
+$n = unshift @a, "rec0", "rec1", "rec2";
+$n = unshift @a, "rec3", "rec4$:";
+@$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
+@old = splice(@h, 1, 2, qw(bananas just before));
+unlink <"$filename*">;
+package XS::APItest; require XSLoader; XSLoader::load()
+$pa = { -exitval => $pa };
+$pa = { -message => $pa };
+pop @lines while $lines[-1] eq "";
+pop @to while $#to and $to[$#to] == $to[$#to -1];
+pop(@$x); unshift(@q, $q);
+@prgs = (@prgs, $file, split "\n########\n", <$fh>) ;
+print "LA LA LA\n" while 1;          # loops forever
+prog => 'use Config; CHECK { $Config{awk} }',
+$p->{share_dir} = { dist => [ $p->{share_dir} ] };
+$p->{share_dir} = { dist => $p->{share_dir} };
+-sleep
+$resp = [$resp]
+$r = eval q[ qr/$r(??{$x})/; ];
+$r = qr/$r(??{$x})/;
+s/a|/push @bar, 1/e;
+$self->{DIR} = [grep $_, split ":", $self->{DIR}];
+$share_dir->{dist} = [ $share_dir->{dist} ];
+s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,#_;END{print"@m"}'
+$spec = [$spec, $_[0]];
+*s = ~(*s);
+$stack[$i++] &= ~1;
+$step = [$step];
+sub CHECK {print ":check"}
+sub INIT {print ":init"}
+system("find . -type f -print     | xargs chmod 0444");
+the while clause.  */
+Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers
+*tmpl = ~*tmpl;
+*tmps = ~*tmps;
+until ($i) { }
+weaken($objs[@objs] = $h{$_} = []);
+weaken($objs[@objs] = $$h{$_} = []);
+while (1) { my $k; }
+while(1) { sleep(1); }
+while($foo--) { print("In thread $thread\n"); }
+"words" =~ /(word|word|word)(?{push @got, $1})s$/;
+"words" =~ /(word|word|word)(?{push @got,$1})s$/i;
+$x->[$j] -= $BASE if $car = (($x->[$j] += $car) >= $BASE) ? 1 : 0; $j++;
+$x->[scalar @$x] = 0;		# avoid || 0 test inside loop
+$z = splice @a, 3, 1, "recordZ";
 end
  @exceptions{@exceptions} = ();
 }