Porting/thirdclean

   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;