mcs/tools/monogrind.pl

   1 #!/usr/bin/perl
   2 #
   3 # Valgrind a Mono-based app.
   4 #
   5 # 8 March 2005
   6 #
   7 # Nat Friedman <nat@novell.com>
   8 #
   9 # Usage:
  10 #     monogrind [valgrind options] foo.exe [foo.exe options]
  11 #
  12
  13 use IPC::Open3;
  14
  15 my $valgrind_options = "";
  16 my $exe_options = "";
  17 my $exe = "";
  18 my $got_exe = 0;
  19
  20 foreach my $arg (@ARGV) {
  21     if ($arg =~ /.*\.exe$/) {
  22         $exe = $arg;
  23         $got_exe = 1;
  24     } elsif ($got_exe == 1) {
  25         $exe_options .= " $arg";
  26     } else {
  27         $valgrind_options .= " $arg";
  28     }
  29 }
  30
  31 my $cmd = "valgrind $valgrind_options mono -v $exe $exe_options";
  32
  33 my ($wtr, $rdr, $err);
  34 $pid = open3 ($wtr, $rdr, $err, $cmd);
  35
  36 # Where we hold the IP/Method mappings
  37 my @map = ();
  38
  39 # Build up all the stderr stuff and process it en masse at the end
  40 $valgrind_output = "";
  41
  42 while (<$rdr>) {
  43     $_ =~ s,\n,,g;
  44     $_ =~ s,\r,,g;
  45
  46     if ($_ =~ /^Method/) {
  47         $method = $ip1 = $ip2 = $_;
  48
  49         $method =~ s,^Method (.*) emitted at.*$,\1,;
  50         $ip1 =~ s,^.*emitted at (0x[a-f0-9]*).*$,\1,;
  51         $ip2 =~ s,^.*to (0x[a-f0-9]*).*$,\1,g;
  52
  53         my %entry = ( "method" => $method,
  54                       "ip1" => $ip1,
  55                       "ip2" => $ip2 );
  56
  57         push (@map, \%entry);
  58         $i ++;
  59     } elsif ($_ =~ /^==/)  {
  60         $valgrind_output .= "$_\n";
  61     } else {
  62         print "$_\n";
  63     }
  64 }
  65
  66 # Read the rest of stderr
  67 while (<$err>) {
  68     $valgrind_output .= "$_\n";
  69 }
  70
  71 my @valgrind_lines = split (/\n/, $valgrind_output);
  72 foreach my $val_line (@valgrind_lines) {
  73     $_ = $val_line;
  74     if ($_ =~ /\?\?\?/) {
  75         $ip = $_;
  76         $ip =~ s,^.*by (0x[A-Fa-f0-9]*): \?\?\?.*$,\1,g;
  77         $ip = lc ($ip);
  78         $ip =~ s,\n,,g;
  79         $ip =~ s,\r,,g;
  80
  81         my $last = "UNKNOWN";
  82         foreach my $m (@map) {
  83             if (hex ($ip) < hex ($$m{"ip1"})) {
  84                 $_ =~ s,\?\?\?,$last,g;
  85                 break;
  86             }
  87             $last = $$m{"method"};
  88         }
  89     }
  90
  91     print "$_\n";
  92 }