perf/run-perf-test.pl

   1 #! /usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use DBI;
   7
   8 use Sys::Hostname();
   9
  10 sub parse_output {
  11   my ($fh, $callback)= @_;
  12
  13   my $current;
  14   my $state= undef;
  15   my ($run_index, $counter_index, $fixed_count);
  16
  17   while(<$fh>)
  18   {
  19     print;
  20     if (/^T: (.*?)( \{(.*?)\})?( \[(.*?)(;.*?)?\])? I=([0-9]+)( U=([0-9]+))?$/) {
  21       $callback->($current) if defined($current);
  22       $current= { MINOR => $1,
  23                   ITERATIONS => $7,
  24                   LIST => []
  25       };
  26       $current->{VARIANT}= $3 if defined($3);
  27       if (defined($5)) {
  28         $current->{PARAM1}= $5;
  29         $current->{PARAM2}= substr($6, 1) if defined($6);
  30       }
  31       $current->{WORKUNITS}= $9 if defined($9);
  32       $run_index= undef;
  33       $counter_index= 0;
  34     }
  35     elsif (/^  Seconds: ([0-9]+\.[0-9]+)(( [-+][0-9]+\.[0-9]+)*)$/)
  36     {
  37       $current->{ELAPSED}= [$1];
  38       push @{$current->{ELAPSED}}, $1 + $_ for (split(" ", $2));
  39     }
  40     elsif (/^  (F: |V[0-9]:|   ) ([^ ]+)\s+([0-9]+)((\s+[-+][0-9]+)*)$/)
  41     {
  42       my ($hdr, $name, $count, $deltas)= ($1, $2, $3, $4);
  43       if ($hdr eq 'F: ' || ($hdr eq '   ' && !defined($run_index)))
  44       {
  45         my $idx= 0;
  46         $current->{LIST}[$idx][$counter_index]= {NAME => $name,
  47                                                  COUNT => $count };
  48         for (split(" ", $deltas))
  49         {
  50           $idx++;
  51           $current->{LIST}[$idx][$counter_index]= {NAME => $name,
  52                                                    COUNT => $count + $_ };
  53         }
  54         $counter_index++;
  55         $fixed_count= $counter_index;
  56       }
  57       else
  58       {
  59         if ($hdr =~ /^V([0-9]):$/)
  60         {
  61           $run_index= $1 - 1;
  62           $counter_index= $fixed_count;
  63         }
  64
  65         $current->{LIST}[$run_index][$counter_index]= { NAME => $name,
  66                                                         COUNT => $count };
  67         $counter_index++;
  68       }
  69     }
  70   }
  71
  72   $callback->($current) if defined($current);
  73 }
  74
  75 sub insert_in_db {
  76   my ($dbh, $e, $suite_id, $major)= @_;
  77
  78   $dbh->begin_work();
  79
  80   my $sql= <<SQL;
  81 INSERT INTO perf_test_run(suite_run_id, test_major, test_minor, param1, param2,
  82             variant, iterations, workunits)
  83      VALUES (?, ?, ?, ?, ?, ?, ?, ?)
  84 SQL
  85   $dbh->do($sql, undef, $suite_id, $major, $e->{MINOR}, $e->{PARAM1}, $e->{PARAM2},
  86            $e->{VARIANT}, $e->{ITERATIONS}, $e->{WORKUNITS});
  87 #  my $test_run_id= $dbh->{mysql_inserid};
  88 my $test_run_id= $dbh->selectall_arrayref("SELECT LAST_INSERT_ID()")->[0][0];
  89
  90   $sql= "INSERT INTO perf_wallclock(test_run_id, instance_idx, secs) VALUES";
  91   my $sep= "";
  92   my @values= ();
  93   for (my $idx= 0; $idx < @{$e->{ELAPSED}}; $idx++)
  94   {
  95     $sql.= $sep ." (?, ?, ?)";
  96     $sep= ",";
  97     push @values, $test_run_id, $idx, $e->{ELAPSED}[$idx];
  98   }
  99   $dbh->do($sql, undef, @values);
 100
 101   $sql= "INSERT INTO perf_counts(test_run_id, instance_idx, counter_idx, counter_name, counter_value) VALUES";
 102   $sep= "";
 103   @values= ();
 104   for (my $run_idx= 0; $run_idx < @{$e->{LIST}}; $run_idx++)
 105   {
 106     for (my $counter_idx= 0; $counter_idx < @{$e->{LIST}[$run_idx]}; $counter_idx++)
 107     {
 108       $sql.= $sep ." (?, ?, ?, ?, ?)";
 109       $sep= ",";
 110       push @values, $test_run_id, $run_idx, $counter_idx,
 111            $e->{LIST}[$run_idx][$counter_idx]{NAME},
 112            $e->{LIST}[$run_idx][$counter_idx]{COUNT};
 113     }
 114   }
 115   $dbh->do($sql, undef, @values);
 116
 117   $dbh->commit();
 118 }
 119
 120 sub get_host_id {
 121   my ($dbh)= @_;
 122
 123   my $hostname= Sys::Hostname::hostname();
 124
 125   my $os= qx{uname -o};
 126   chomp($os);
 127   my $kernel= qx{uname -r};
 128   chomp($kernel);
 129   my $arch= qx{uname -m};
 130   chomp($arch);
 131   my $cpu_name= "<unknown>";
 132   my $cpu_mhz= "<unknown>";
 133   if (open(FH, '<', '/proc/cpuinfo'))
 134   {
 135     while (<FH>)
 136     {
 137       $cpu_name= $1 if /^model name\s*  : (.*)$/;
 138       $cpu_mhz= $1 if /^cpu MHz\s*      : (.*)$/;
 139       # For multicore we will get multiple hits, but it doesn't really matter.
 140     }
 141     close FH;
 142   }
 143
 144   my $sql= <<SQL;
 145 SELECT id
 146   FROM perf_host
 147  WHERE hostname = ? AND os = ? AND kernel = ? AND arch = ? AND cpu_name = ? AND cpu_mhz = ?
 148 SQL
 149   my $res= $dbh->selectall_arrayref($sql, undef,
 150                                     $hostname, $os, $kernel, $arch, $cpu_name, $cpu_mhz);
 151   return $res->[0][0] if ($res && @$res);
 152
 153   # Not there already, so need to insert a new one.
 154   $sql= <<SQL;
 155 INSERT INTO perf_host (hostname, os, kernel, arch, cpu_name, cpu_mhz)
 156 VALUES (?, ?, ?, ?, ?, ?)
 157 SQL
 158   $dbh->do($sql, undef, $hostname, $os, $kernel, $arch, $cpu_name, $cpu_mhz);
 159   #my $shost_id= $dbh->{mysql_inserid};
 160   my $host_id= $dbh->selectall_arrayref("SELECT LAST_INSERT_ID()")->[0][0];
 161   return $host_id;
 162 }
 163
 164 sub get_git_rev {
 165   my $rev= qx{git-rev-list HEAD^..HEAD};
 166   if ($rev)
 167   {
 168     chomp($rev);
 169
 170     # Check for local uncommitted modifications.
 171     system("git-diff", "--quiet");
 172     $rev= "* ". $rev if $?;
 173
 174     return $rev;
 175   }
 176   else
 177   {
 178     return "<Unknown>";
 179   }
 180 }
 181
 182 sub get_suite_run_id {
 183   my ($dbh)= @_;
 184
 185   my $host_id= get_host_id($dbh);
 186   my $git_rev= get_git_rev();
 187   $dbh->do("INSERT INTO perf_suite_run(dt, code_rev, host_id) VALUES (NOW(), ?, ?)",
 188            undef, $git_rev, $host_id);
 189   #my $suite_run_id= $dbh->{mysql_inserid};
 190   my $suite_run_id= $dbh->selectall_arrayref("SELECT LAST_INSERT_ID()")->[0][0];
 191   return $suite_run_id;
 192 }
 193
 194
 195 die "Usage: $0 <DBHOST> <DBUSER> <DBPASS> [test ...]\n"
 196     unless @ARGV >= 3;
 197 my ($host, $user, $pass, @requested_tests)= @ARGV;
 198
 199 my $dbh= DBI->connect("dbi:mysql:database=beedb;host=$host", $user, $pass,
 200                       { RaiseError => 1, PrintError => 0 });
 201
 202 my $test_list;
 203
 204 if (@requested_tests) {
 205   $test_list= [map($_ . (/\.t$/ ? '' : '.t'), @requested_tests)];
 206 } else {
 207   $test_list= [glob('*.t')];
 208 }
 209
 210 exit 0 unless @$test_list;
 211
 212 my $suite_run_id= get_suite_run_id($dbh);
 213
 214 for my $test (@$test_list)
 215 {
 216   my $test_major= substr($test, 0, -2);
 217
 218   open CHILD, "./$test|"
 219       or die "Failed to spawn child '$test': $!\n";
 220   print "Running test '$test'...\n";
 221   parse_output(\*CHILD, sub { insert_in_db($dbh, $_[0], $suite_run_id, 'bitcopy'); });
 222   close CHILD;
 223 }
 224
 225 $dbh->disconnect();