allow use threads qw(yield)

[p5sagit/p5-mst-13.2.git] / Porting / thirdclean

local $/;
$_ = <ARGV>;

my @accv = /(^-+ \w+ -- \d+ --(?:.(?!^-))+)/msg;
my @leak = /(\d+ bytes? in \d+ leaks? .+? created at:(?:.(?!^\d))+)/msg;

$leak[ 0] =~ s/.* were found:\n\n//m; # Snip off totals.
$leak[-1] =~ s/^-+.*//ms; # Snip off final memory layout.

# Weed out the known access violations.

@accv = grep { ! /-- ru[hs] --.+setlocale.+Perl_init_i18nl10n/s }  @accv;
@accv = grep { ! /-- (?:fon|ris) --.+__strxfrm_sb/s }              @accv;
@accv = grep { ! /-- rih --.+memmove.+sv_catpv.+moreswitches/s }   @accv;
@accv = grep { ! /-- (?:rih|rus) --.+strcpy.+gv_fetchfile/s }      @accv;
@accv = grep { ! /-- rus --.+_doprnt_dis/s }                       @accv;
@accv = grep { ! /-- rih --.+strcmp.+doopen_pmc/s }                @accv;
@accv = grep { ! /-- rih --.+memmove.+my_setenv/s }                @accv;

# Weed out the known memory leaks.

@leak = grep { ! /setlocale.+Perl_init_i18nl10n/s }   @leak;
@leak = grep { ! /setlocale.+set_numeric_standard/s } @leak;
@leak = grep { ! /_findiop.+fopen/s }                 @leak;
@leak = grep { ! /_findiop.+__fdopen/s }              @leak;
@leak = grep { ! /Perl_new\w+.+Perl_yyparse/s }       @leak;

# Output the cleaned up report.

# Access violations.

for (my $i = 0; $i < @accv; $i++) {
  $_ = $accv[$i];
  s/\d+/$i/;
  print;
}

# Memory leaks.

my ($leakb, $leakn, $leaks);

for (my $i = 0; $i < @leak; $i++) {
  $_ = $leak[$i];
  print $_, "\n";
  /^(\d+) bytes? in (\d+) leak/;
  $leakb += $1;
  $leakn += $2;
  $leaks += $1 if /including (\d+) super/;
}

print "Bytes $leakb Leaks $leakn Super $leaks\n" if $leakb;