1 |
#!./perl |
2 |
|
3 |
# DAPM: this description is from the original commit message: |
4 |
# this appears to be a HP leak detection thing: |
5 |
# |
6 |
# Add a script for cleaning out the "known noise" |
7 |
# from Third Degree reports: either noise caused |
8 |
# by libc itself, or Perl_yyparse leaks. |
9 |
|
10 |
local $/; |
11 |
$_ = <ARGV>; |
12 |
|
13 |
my @accv = /(^-+ \w+ -- \d+ --(?:.(?!^-))+)/msg; |
14 |
my @leak = /(\d+ bytes? in \d+ leaks? .+? created at:(?:.(?!^[\d-]))+)/msg; |
15 |
|
16 |
$leak[ 0] =~ s/.* were found:\n\n//m; # Snip off totals. |
17 |
|
18 |
# Weed out the known access violations. |
19 |
|
20 |
@accv = grep { ! /-- ru[hs] --.+setlocale.+Perl_init_i18nl10n/s } @accv; |
21 |
@accv = grep { ! /-- [rw][ui]s --.+_doprnt_dis/s } @accv; |
22 |
@accv = grep { ! /-- (?:fon|ris) --.+__strxfrm/s } @accv; |
23 |
@accv = grep { ! /-- rus --.+__catgets/s } @accv; |
24 |
@accv = grep { ! /-- rus --.+__execvp/s } @accv; |
25 |
@accv = grep { ! /-- rus --.+tmpnam.+tmpfile/s } @accv; |
26 |
@accv = grep { ! /-- rus --.+__gethostbyname/s } @accv; |
27 |
@accv = grep { ! /-- ris --.+__actual_atof/s } @accv; |
28 |
@accv = grep { ! /-- ris --.+__strftime/s } @accv; |
29 |
|
30 |
# Weed out untraceable access violations. |
31 |
@accv = grep { ! / ----- /s } @accv; |
32 |
@accv = grep { ! /-- r[ui][hs] --.+proc_at_/s } @accv; |
33 |
@accv = grep { ! /-- r[ui][hs] --.+pc = 0x/s } @accv; |
34 |
|
35 |
# The following look like being caused by the intrinsic inlined |
36 |
# string handling functions reading one or few bytes beyond the |
37 |
# actual length. |
38 |
@accv = grep { ! /-- rih --.+(?:memmove|strcpy).+moreswitches/s } @accv; |
39 |
@accv = grep { ! /-- (?:rih|rus) --.+strcpy.+gv_fetchfile/s } @accv; |
40 |
@accv = grep { ! /-- rih --.+strcmp.+doopen_pm/s } @accv; |
41 |
@accv = grep { ! /-- rih --.+strcmp.+gv_fetchpv/s } @accv; |
42 |
@accv = grep { ! /-- r[ui]h --.+strcmp.+gv_fetchmeth/s } @accv; |
43 |
@accv = grep { ! /-- rih --.+memmove.+my_setenv/s } @accv; |
44 |
@accv = grep { ! /-- rih --.+memmove.+catpvn_flags/s } @accv; |
45 |
|
46 |
# yyparse. |
47 |
@accv = grep { ! /Perl_yyparse/s } @accv; |
48 |
|
49 |
# Weed out the known memory leaks. |
50 |
|
51 |
@leak = grep { ! /setlocale.+Perl_init_i18nl10n/s } @leak; |
52 |
@leak = grep { ! /setlocale.+set_numeric_standard/s } @leak; |
53 |
@leak = grep { ! /_findiop.+fopen/s } @leak; |
54 |
@leak = grep { ! /_findiop.+__fdopen/s } @leak; |
55 |
@leak = grep { ! /__localtime/s } @leak; |
56 |
@leak = grep { ! /__get_libc_context/s } @leak; |
57 |
@leak = grep { ! /__sia_init/s } @leak; |
58 |
|
59 |
# Weed out untraceable memory leaks. |
60 |
@leak = grep { ! / ----- /s } @leak; |
61 |
@leak = grep { ! /pc = 0x/s } @leak; |
62 |
@leak = grep { ! /_pc_range_table/s } @leak; |
63 |
@leak = grep { ! /_add_gp_range/s } @leak; |
64 |
|
65 |
# yyparse. |
66 |
@leak = grep { ! /Perl_yyparse/s } @leak; |
67 |
|
68 |
# Output the cleaned up report. |
69 |
|
70 |
# Access violations. |
71 |
|
72 |
for (my $i = 0; $i < @accv; $i++) { |
73 |
$_ = $accv[$i]; |
74 |
s/\d+/$i/; |
75 |
print; |
76 |
} |
77 |
|
78 |
# Memory leaks. |
79 |
|
80 |
my ($leakb, $leakn, $leaks); |
81 |
|
82 |
for (my $i = 0; $i < @leak; $i++) { |
83 |
$_ = $leak[$i]; |
84 |
print $_, "\n"; |
85 |
/^(\d+) bytes? in (\d+) leak/; |
86 |
$leakb += $1; |
87 |
$leakn += $2; |
88 |
$leaks += $1 if /including (\d+) super/; |
89 |
} |
90 |
|
91 |
print "Bytes $leakb Leaks $leakn Super $leaks\n" if $leakb; |