This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Introduce a new preprocessor symbol, PERL_DISABLE_PMC, to
[perl5.git] / Porting / thirdclean
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;