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