From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue, 14 May 2002 16:09:59 +0000 (+0000)
Subject: Add a script for cleaning out the "known noise"
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a7a6c8b10a9aa6a3798dada669f7b74961355ab6;p=p5sagit%2Fp5-mst-13.2.git

Add a script for cleaning out the "known noise"
from Third Degree reports: either noise caused
by libc itself, or Perl_yyparse leaks.

p4raw-id: //depot/perl@16593
---

diff --git a/MANIFEST b/MANIFEST
index cab3a2c..6c00f87 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2213,6 +2213,7 @@ Porting/patchls		Flexible patch file listing utility
 Porting/pumpkin.pod	Guidelines and hints for Perl maintainers
 Porting/repository.pod	How to use the Perl repository
 Porting/testall.atom	Cumulative profile of the test suite with Third Degree
+Porting/thirdclean	Cleanup Third Degree reports
 pp.c				Push/Pop code
 pp.h				Push/Pop code defs
 pp.sym				Push/Pop code symbols
diff --git a/Porting/thirdclean b/Porting/thirdclean
new file mode 100644
index 0000000..de1946b
--- /dev/null
+++ b/Porting/thirdclean
@@ -0,0 +1,51 @@
+local $/;
+$_ = <ARGV>;
+
+my @accv = /(^-+ \w+ -- \d+ --(?:.(?!^-))+)/msg;
+my @leak = /(\d+ bytes? in \d+ leaks? .+? created at:(?:.(?!^\d))+)/msg;
+
+$leak[ 0] =~ s/.* were found:\n\n//m; # Snip off totals.
+$leak[-1] =~ s/^-+.*//ms; # Snip off final memory layout.
+
+# Weed out the known access violations.
+
+@accv = grep { ! /-- ru[hs] --.+setlocale.+Perl_init_i18nl10n/s }  @accv;
+@accv = grep { ! /-- (?:fon|ris) --.+__strxfrm_sb/s }              @accv;
+@accv = grep { ! /-- rih --.+memmove.+sv_catpv.+moreswitches/s }   @accv;
+@accv = grep { ! /-- (?:rih|rus) --.+strcpy.+gv_fetchfile/s }      @accv;
+@accv = grep { ! /-- rus --.+_doprnt_dis/s }                       @accv;
+@accv = grep { ! /-- rih --.+strcmp.+doopen_pmc/s }                @accv;
+@accv = grep { ! /-- rih --.+memmove.+my_setenv/s }                @accv;
+
+# Weed out the known memory leaks.
+
+@leak = grep { ! /setlocale.+Perl_init_i18nl10n/s }   @leak;
+@leak = grep { ! /setlocale.+set_numeric_standard/s } @leak;
+@leak = grep { ! /_findiop.+fopen/s }                 @leak;
+@leak = grep { ! /_findiop.+__fdopen/s }              @leak;
+@leak = grep { ! /Perl_new\w+.+Perl_yyparse/s }       @leak;
+
+# Output the cleaned up report.
+
+# Access violations.
+
+for (my $i = 0; $i < @accv; $i++) {
+  $_ = $accv[$i];
+  s/\d+/$i/;
+  print;
+}
+
+# Memory leaks.
+
+my ($leakb, $leakn, $leaks);
+
+for (my $i = 0; $i < @leak; $i++) {
+  $_ = $leak[$i];
+  print $_, "\n";
+  /^(\d+) bytes? in (\d+) leak/;
+  $leakb += $1;
+  $leakn += $2;
+  $leaks += $1 if /including (\d+) super/;
+}
+
+print "Bytes $leakb Leaks $leakn Super $leaks\n" if $leakb;