Commit | Line | Data |
---|---|---|
0c429c78 DM |
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 | ||
a7a6c8b1 JH |
10 | local $/; |
11 | $_ = <ARGV>; | |
12 | ||
13 | my @accv = /(^-+ \w+ -- \d+ --(?:.(?!^-))+)/msg; | |
f27ead98 | 14 | my @leak = /(\d+ bytes? in \d+ leaks? .+? created at:(?:.(?!^[\d-]))+)/msg; |
a7a6c8b1 JH |
15 | |
16 | $leak[ 0] =~ s/.* were found:\n\n//m; # Snip off totals. | |
a7a6c8b1 JH |
17 | |
18 | # Weed out the known access violations. | |
19 | ||
20 | @accv = grep { ! /-- ru[hs] --.+setlocale.+Perl_init_i18nl10n/s } @accv; | |
f27ead98 JH |
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; | |
fe18a095 | 24 | @accv = grep { ! /-- rus --.+__execvp/s } @accv; |
f27ead98 JH |
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 | ||
fe18a095 JH |
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. | |
f27ead98 | 38 | @accv = grep { ! /-- rih --.+(?:memmove|strcpy).+moreswitches/s } @accv; |
a7a6c8b1 | 39 | @accv = grep { ! /-- (?:rih|rus) --.+strcpy.+gv_fetchfile/s } @accv; |
7925835c | 40 | @accv = grep { ! /-- rih --.+strcmp.+doopen_pm/s } @accv; |
f27ead98 JH |
41 | @accv = grep { ! /-- rih --.+strcmp.+gv_fetchpv/s } @accv; |
42 | @accv = grep { ! /-- r[ui]h --.+strcmp.+gv_fetchmeth/s } @accv; | |
a7a6c8b1 | 43 | @accv = grep { ! /-- rih --.+memmove.+my_setenv/s } @accv; |
f27ead98 JH |
44 | @accv = grep { ! /-- rih --.+memmove.+catpvn_flags/s } @accv; |
45 | ||
46 | # yyparse. | |
47 | @accv = grep { ! /Perl_yyparse/s } @accv; | |
a7a6c8b1 JH |
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; | |
f27ead98 JH |
55 | @leak = grep { ! /__localtime/s } @leak; |
56 | @leak = grep { ! /__get_libc_context/s } @leak; | |
57 | @leak = grep { ! /__sia_init/s } @leak; | |
f27ead98 JH |
58 | |
59 | # Weed out untraceable memory leaks. | |
60 | @leak = grep { ! / ----- /s } @leak; | |
fe18a095 JH |
61 | @leak = grep { ! /pc = 0x/s } @leak; |
62 | @leak = grep { ! /_pc_range_table/s } @leak; | |
63 | @leak = grep { ! /_add_gp_range/s } @leak; | |
f27ead98 JH |
64 | |
65 | # yyparse. | |
66 | @leak = grep { ! /Perl_yyparse/s } @leak; | |
a7a6c8b1 JH |
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; |