blob: de1946b880991d7d132301ce123b3a48d0c744be (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
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;
|
