perl script to analyze the memcheck.out file generated by the new memory

checker. The ./configure script copies memprobe.in to bin/memprobe.


git-svn-id: http://root.cern.ch/svn/root/trunk@2846 27541ba8-7e3a-0410-8455-c3a389f83636

config/memprobe.in

+#!@perl@
+
+#################################################################
+#        (c) 2000 
+#         Authors : D.Bertini and M.Ivanov
+#         Date: 23/10/2000
+#         Updated: 10/05/2001 D.Bertini
+#                  (v2.0 port to gdb5.0 + glibc2.2)
+#
+#
+#################################################################
+
+
+if ( ( $#ARGV < 0 )) {
+Usage();
+}
+
+use Getopt::Std;
+
+getopt "h,e,m,d,f";
+#Usage("exec file is mandatory !\n") if ( !($opt_h or $opt_e) );
+
+if ( $opt_h ) {   Usage();}
+if ( $opt_e ) {  $ExeFile=$opt_e;
+	       }else { 
+		if (!$opt_h){ Usage("an exec file must be provided  !\n");}
+               }
+if ( $opt_m ) {  $MemStatFile=$opt_m;
+	       }else{
+                $MemStatFile="memcheck.out";
+	      }  
+if ( $opt_d ) {  $MemDescFile=$opt_d;
+               }else{
+                 $MemDescFile="memcheckdesc.out";
+              }  
+
+if ( $opt_f ) {  $MemFiltFile=$opt_f;
+	       }else{
+		 $MemFiltFile="analfilter";
+	       } 
+
+
+sub Usage
+{
+	my ($txt) = @_;
+
+	print "MemProbe v2.0 Usage:\n";
+	print "\t $0 -e exec-file [options] [files] \n ";
+        print "\t-e \t\t\tname of analyzed program\n";  
+	print "Options: \n";
+        print "\t-h \t\t\tthis usage help\n"; 
+        print "\t-m  \t\tname of analyzed program output file\n";
+        print "\t-d \t\tname of the stat description file\n";
+        print "\t-f  \t\tname of the filter file\n";
+	print "\nWarning: $txt\n" if $txt;
+
+	exit 2;
+}
+
+
+# old version
+#$ExeFile = shift @ARGV;
+#$MemStatFile = $#ARGV >= 0 ? shift @ARGV : "memcheck.out";
+
+open (MEMSTAT, $MemStatFile) or die "-E- Could not open leaks data file $MemStatFile: $!";
+
+if ($#ARGV >= 0) {
+  $BreakOn = shift @ARGV;
+  # Rest in @ARGV are program arguments
+}
+
+
+##############################################################################
+#              Read filter expression
+##############################################################################
+
+open (FILTERFILE, $MemFiltFile); 
+@FILTER = <FILTERFILE>;
+close (FILTERFILE);
+for ($j = 0; $j <= $#FILTER; ++$j){
+  chop $FILTER[$j];
+  #    print $FILTER[$j];
+}
+
+##############################################################################
+#              Find  leak adresses
+##############################################################################
+
+$n = $u = 0;
+$nfull = $ufull = 0;
+
+while (<MEMSTAT>) {
+  # remove newline
+  chop $_ ;
+  
+  if (/\s*(stack:)\s*/) {
+    $addrfull = $';  #obtain stack info
+    $_ = $addrfull;
+    s/(st)//g;
+    s/(0x)/:0x/g;
+    @arr = split(/:/);  #obtain different leak points   
+    for ($i = 1; $i < $#arr; ++$i){
+      $addr =  $arr[$i];
+      $u++ if not exists $Size{$addr};
+      $Size{$addr} += 0;
+      $n++;       
+    }
+  }    
+}
+close (MEMSTAT);
+
+
+##############################################################################
+#             FIND  debug info for  addresses - information stored 
+#             in file leak.desc.C
+##############################################################################
+
+
+# redirect standard output to the trash
+open (STDERR,">/dev/null");
+
+# Redirect list of commands to a file
+# using unix pipes ( needed for RH.7.1 & gdb5.0)
+
+open (myFile,">commands");
+
+# Change set listsize 2 to something else to show more lines
+print myFile "set prompt\nset listsize 1\nset height 0\nset verbose off\n";
+
+
+if (defined($BreakOn)) {
+  print myFile "break $BreakOn\n";
+  print myFile "run ", join(" ", @ARGV), " \n";
+}
+else{
+  print myFile "break main \n ";
+  print myFile "run ", join(" ", @ARGV), " \n";
+}
+
+foreach (sort keys %Size) {
+  print myFile "l \*$_\n ";
+}
+
+if (defined($BreakOn)) {
+  print myFile "kill\n";
+}
+close (myFile);
+
+##############################################################################
+#               Calling now gdb services in batch mode using 
+#               dumped list of commands.    
+#               ==> works with gdb-4.18 gdb-5.0 release versions )
+##############################################################################
+
+
+open (PIPE, "|/d/hades/denis/gdb-4.18/gdb/gdb -n -q $ExeFile < commands > $MemDescFile") 
+or die "-E- Cannot start gdb !!!";
+close (PIPE);
+
+
+
+##############################################################################
+#                ASIGN debug info to address
+##############################################################################
+
+open (DBGinfo, $MemDescFile) or die "-E- Could not open desc file $MemDescFile: $!";
+$addr =0; 
+while (<DBGinfo>){  
+  #  if (/(0x[0-9a-f]+)\s*/){
+  if (/(^0x[0-9a-f]+)/){
+    $addr = $1;
+    #print $addr;
+    /is in /;
+    #    print $';
+    #    print "\n";
+    $filename{$addr} =$';
+    #    print "$addr   $filename{$addr}\n";
+  }else{
+    $line{$addr} = $_;
+  }  
+  for ($j = 0; $j <= $#FILTER; ++$j){
+    if (   ( $line{$addr} =~ /(${FILTER[$j]})/ )  ||
+      ( $filename{$addr} =~ /(${FILTER[$j]})/ )){
+  $line{$addr} = "filtered";
+}
+}
+
+}
+close (DBGinfo);
+
+##############################################################################
+#                   FIND unique leak stack sequences
+##############################################################################
+
+open (MEMSTAT, $MemStatFile) or die "-E- Could not open leaks data file $MemStatFile: $!";
+
+while (<MEMSTAT>) {
+  # remove newline
+  chop $_ ;    
+  if (/\s*(stack:)\s*/) {
+    $addrfull = $';  #obtain stack info
+    $info =$`;
+    $info =~ s/size //; #obtain mem info for given stack sequence
+    $_ = $addrfull;
+    s/(st)//g;
+    s/(0x)/:0x/g;
+    s/ //g;
+    @arr = split(/:/);  #obtain leak points
+    $addrfull ="stack";
+    $FilterOut=0;
+    for ($i = 1; ($i <= $#arr)&&($FilterOut==0); ++$i){
+      $addr =  $arr[$i];
+      if ( $line{$addr} =~ /filtered/)
+	{	        
+	  $FilterOut=1;
+	}  
+      if ( $filename{$addr} =~ /\)/) 
+	{
+	  $addrfull .=  ":";
+	  $addrfull .=  $addr;	
+	}
+    } 
+    if ($FilterOut==0){
+      $_= $info;
+      @meminfo = split(/:/);
+      $ufull++ if not exists $Sizefull{$addrfull};
+      $SizeTotal{$addrfull} += $meminfo[1];   
+      $CountTotal{$addrfull}+= $meminfo[0];
+      $SizeLeak{$addrfull} += $meminfo[3];   
+      $CountLeak{$addrfull}+= $meminfo[2];
+      $nfull++;       
+    }
+  }
+}    
+
+print STDERR "total memory corrupted at point==> ($nfull) \n";   
+print STDERR "unique allocations ==> ($ufull) \n";
+
+close (MEMSTAT);
+
+##############################################################################
+#            PRINT output leak information to leak.info.C  output file 
+##############################################################################
+
+
+open (LEAKinfo,">leak.info");
+open (MULTI,">multidelete.info");
+open (MEMSTAT,">memcheck.info");
+
+# sort by size of leak 
+sub bysize {
+  $SizeLeak{$b} <=> $SizeLeak{$a};      # presuming integers
+}
+
+sub bysizetotal {
+  $SizeTotal{$b} <=> $SizeTotal{$a};      # presuming integers
+}
+
+foreach  (sort bysizetotal keys   %SizeTotal) {
+  print MEMSTAT "Count: $CountTotal{$_}($CountLeak{$_})   Size: $SizeTotal{$_}($SizeLeak{$_}) \n";
+  s/stack://g;
+  @arr = split(/:/);  #obtain leak points       
+  for ($i = 0; $i <= $#arr; ++$i){	 
+    $addr =  $arr[$i];
+    print MEMSTAT "$filename{$addr}$line{$addr}";
+  }
+  print MEMSTAT "\n\n";
+}
+
+
+foreach  (sort bysize keys   %SizeLeak) {
+  if ($CountLeak{$_}<0){
+    print MULTI "Multiple deallocation :$CountLeak{$_}\n";
+    s/stack://g;
+    @arr = split(/:/);  #obtain leak points       
+    for ($i = 0; $i <= $#arr; ++$i){	 
+      $addr =  $arr[$i];
+      print MULTI "$filename{$addr}$line{$addr}";
+    }
+    print MULTI "\n\n";
+  }
+  if ($SizeLeak{$_}!=0){
+    print LEAKinfo "Leaked allocations: $CountLeak{$_} \t Leaked size: $SizeLeak{$_} \n";
+    s/stack://g;
+    @arr = split(/:/);  #obtain leak points       
+    for ($i = 0; $i <= $#arr; ++$i){	 
+      $addr =  $arr[$i];
+      print LEAKinfo "$filename{$addr}$line{$addr}";
+    }
+    print LEAKinfo "\n\n";
+  }
+}
+close(LEAKinfo);
+close(MULTI);
+close(MEMSTAT);
+
+$remove = 'rm -rf commands';
+exec $remove; 
+die " -E- no commands file !";
+