src/third_party/icu/source/test/perf/perldriver/PerfFramework.pm

   1 #!/usr/local/bin/perl
   2 #  ***********************************************************************
   3 #  * COPYRIGHT:
   4 #  * Copyright (c) 2002-2008, International Business Machines Corporation
   5 #  * and others. All Rights Reserved.
   6 #  ***********************************************************************
   7
   8 use strict;
   9
  10 #use Dataset;
  11 use Format;
  12 use Output;
  13
  14 my $VERBOSE = 0;
  15 my $DEBUG   = 1;
  16 my $start_l = ""; #formatting help
  17 my $end_l   = "";
  18 my @testArgs; # different kinds of tests we want to do
  19 my $datadir = "data";
  20 my $extraArgs; # stuff that always gets passed to the test program
  21
  22
  23 my $iterCount = 0;
  24 my $NUMPASSES = 4;
  25 my $TIME = 2;
  26 my $ITERATIONS;   #Added by Doug
  27 my $DATADIR;
  28
  29 sub setupOptions {
  30   my %options = %{shift @_};
  31
  32   if($options{"time"}) {
  33     $TIME = $options{"time"};
  34   }
  35
  36   if($options{"passes"}) {
  37     $NUMPASSES = $options{"passes"};
  38   }
  39
  40   if($options{"dataDir"}) {
  41     $DATADIR = $options{"dataDir"};
  42   }
  43
  44   # Added by Doug
  45   if ($options{"iterations"}) {
  46         $ITERATIONS = $options{"iterations"};
  47   }
  48 }
  49
  50 sub runTests {
  51   my $options = shift;
  52   my @programs;
  53   my $tests = shift;
  54   my %datafiles;
  55   if($#_ >= 0) { # maybe no files/locales
  56     my $datafiles = shift;
  57     if($datafiles) {
  58       %datafiles = %{$datafiles};
  59     }
  60   }
  61   setupOutput($options);
  62   setupOptions($options);
  63
  64   my($locale, $iter, $data, $program, $args, $variable);
  65 #
  66 #  Outer loop runs through the locales to test
  67 #
  68   if (%datafiles) {
  69     foreach $locale (sort keys %datafiles ) {
  70       foreach $data (@{ $datafiles{$locale} }) {
  71         closeTable;
  72         my $locdata = "";
  73         if(!($locale eq "")) {
  74           $locdata = "<b>Locale:</b> $locale<br>";
  75         }
  76         $locdata .= "<b>Datafile:</b> $data<br>";
  77         startTest($locdata);
  78
  79         if($DATADIR) {
  80           compareLoop ($tests, $locale, $DATADIR."/".$data);
  81         } else {
  82           compareLoop ($tests, $locale, $data);
  83         }
  84       }
  85     }
  86   } else {
  87     compareLoop($tests);
  88   }
  89   closeOutput();
  90 }
  91
  92 sub compareLoop {
  93   my $tests = shift;
  94   #my @tests = @{$tests};
  95   my %tests = %{$tests};
  96   my $locale = shift;
  97   my $datafile = shift;
  98   my $locAndData = "";
  99   if($locale) {
 100     $locAndData .= " -L $locale";
 101   }
 102   if($datafile) {
 103     $locAndData .= " -f $datafile";
 104   }
 105
 106   my $args;
 107   my ($i, $j, $aref);
 108   foreach $i ( sort keys %tests ) {
 109     debug("Test: $i\n");
 110     $aref = $tests{$i};
 111     my @timedata;
 112     my @iterPerPass;
 113     my @noopers;
 114     my @noevents;
 115
 116     my $program;
 117     my @argsAndTest;
 118     for $j ( 0 .. $#{$aref} ) {
 119     # first we calibrate. Use time from somewhere
 120     # first test is used for calibration
 121       ($program, @argsAndTest) = split(/\ /, @{ $tests{$i} }[$j]);
 122       #Modified by Doug
 123       my $commandLine;
 124       if ($ITERATIONS) {
 125         $commandLine = "$program -i $ITERATIONS -p $NUMPASSES $locAndData @argsAndTest";
 126       } else {
 127         $commandLine = "$program -t $TIME -p $NUMPASSES $locAndData @argsAndTest";
 128         }
 129       #my $commandLine = "$program -i 5 -p $NUMPASSES $locAndData @argsAndTest";
 130       my @res = measure1($commandLine);
 131       store("$i, $program @argsAndTest", @res);
 132
 133       push(@iterPerPass, shift(@res));
 134       push(@noopers, shift(@res));
 135       my @data = @{ shift(@res) };
 136       if($#res >= 0) {
 137         push(@noevents, shift(@res));
 138       }
 139
 140
 141       shift(@data) if (@data > 1); # discard first run
 142
 143       #debug("data is @data\n");
 144       my $ds = Dataset->new(@data);
 145
 146       push(@timedata, $ds);
 147     }
 148
 149     outputRow($i, \@iterPerPass, \@noopers, \@timedata, \@noevents);
 150   }
 151
 152 }
 153
 154 #---------------------------------------------------------------------
 155 # Measure a given test method with a give test pattern using the
 156 # global run parameters.
 157 #
 158 # @param the method to run
 159 # @param the pattern defining characters to test
 160 # @param if >0 then the number of iterations per pass.  If <0 then
 161 #        (negative of) the number of seconds per pass.
 162 #
 163 # @return array of:
 164 #         [0] iterations per pass
 165 #         [1] events per iteration
 166 #         [2..] ms reported for each pass, in order
 167 #
 168 sub measure1 {
 169     # run passes
 170     my @t = callProg(shift); #"$program $args $argsAndTest");
 171     my @ms = ();
 172     my @b; # scratch
 173     for my $a (@t) {
 174         # $a->[0]: method name, corresponds to $method
 175         # $a->[1]: 'begin' data, == $iterCount
 176         # $a->[2]: 'end' data, of the form <ms> <eventsPerIter>
 177         # $a->[3...]: gc messages from JVM during pass
 178         @b = split(/\s+/, $a->[2]);
 179         #push(@ms, $b[0]);
 180         push(@ms, shift(@b));
 181     }
 182     my $iterCount = shift(@b);
 183     my $operationsPerIter = shift(@b);
 184     my $eventsPerIter;
 185     if($#b >= 0) {
 186       $eventsPerIter = shift(@b);
 187     }
 188
 189 #    out("Iterations per pass: $iterCount<BR>\n");
 190 #    out("Events per iteration: $eventsPerIter<BR>\n");
 191 #    debug("Iterations per pass: $iterCount<BR>\n");
 192 #    if($eventsPerIter) {
 193 #      debug("Events per iteration: $eventsPerIter<BR>\n");
 194 #    }
 195
 196     my @ms_str = @ms;
 197     $ms_str[0] .= " (discarded)" if (@ms_str > 1);
 198 #    out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
 199     debug("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
 200     if($eventsPerIter) {
 201       ($iterCount, $operationsPerIter, \@ms, $eventsPerIter);
 202     } else {
 203       ($iterCount, $operationsPerIter, \@ms);
 204     }
 205 }
 206
 207
 208
 209 #---------------------------------------------------------------------
 210 # Measure a given test method with a give test pattern using the
 211 # global run parameters.
 212 #
 213 # @param the method to run
 214 # @param the pattern defining characters to test
 215 # @param if >0 then the number of iterations per pass.  If <0 then
 216 #        (negative of) the number of seconds per pass.
 217 #
 218 # @return a Dataset object, scaled by iterations per pass and
 219 #         events per iteration, to give time per event
 220 #
 221 sub measure2 {
 222     my @res = measure1(@_);
 223     my $iterPerPass = shift(@res);
 224     my $operationsPerIter = shift(@res);
 225     my @data = @{ shift(@res) };
 226     my $eventsPerIter = shift(@res);
 227
 228
 229     shift(@data) if (@data > 1); # discard first run
 230
 231     my $ds = Dataset->new(@data);
 232     #$ds->setScale(1.0e-3 / ($iterPerPass * $operationsPerIter));
 233     ($ds, $iterPerPass, $operationsPerIter, $eventsPerIter);
 234 }
 235
 236
 237 #---------------------------------------------------------------------
 238 # Invoke program and capture results, passing it the given parameters.
 239 #
 240 # @param the method to run
 241 # @param the number of iterations, or if negative, the duration
 242 #        in seconds.  If more than on pass is desired, pass in
 243 #        a string, e.g., "100 100 100".
 244 # @param the pattern defining characters to test
 245 #
 246 # @return an array of results.  Each result is an array REF
 247 #         describing one pass.  The array REF contains:
 248 #         ->[0]: The method name as reported
 249 #         ->[1]: The params on the '= <meth> begin ...' line
 250 #         ->[2]: The params on the '= <meth> end ...' line
 251 #         ->[3..]: GC messages from the JVM, if any
 252 #
 253 sub callProg {
 254     my $cmd = shift;
 255     #my $pat = shift;
 256     #my $n = shift;
 257
 258     #my $cmd = "java -cp c:\\dev\\myicu4j\\classes $TESTCLASS $method $n $pat";
 259     debug( "[$cmd]\n"); # for debugging
 260     open(PIPE, "$cmd|") or die "Can't run \"$cmd\"";
 261     my @out;
 262     while (<PIPE>) {
 263         push(@out, $_);
 264     }
 265     close(PIPE) or die "Program failed: \"$cmd\"";
 266
 267     @out = grep(!/^\#/, @out);  # filter out comments
 268
 269     #debug( "[", join("\n", @out), "]\n");
 270
 271     my @results;
 272     my $method = '';
 273     my $data = [];
 274     foreach (@out) {
 275         next unless (/\S/);
 276
 277         if (/^=\s*(\w+)\s*(\w+)\s*(.*)/) {
 278             my ($m, $state, $d) = ($1, $2, $3);
 279             #debug ("$_ => [[$m $state !!!$d!!! $data ]]\n");
 280             if ($state eq 'begin') {
 281                 die "$method was begun but not finished" if ($method);
 282                 $method = $m;
 283                 push(@$data, $d);
 284                 push(@$data, ''); # placeholder for end data
 285             } elsif ($state eq 'end') {
 286                 if ($m ne $method) {
 287                     die "$method end does not match: $_";
 288                 }
 289                 $data->[1] = $d; # insert end data at [1]
 290                 #debug( "#$method:", join(";",@$data), "\n");
 291                 unshift(@$data, $method); # add method to start
 292                 push(@results, $data);
 293                 $method = '';
 294                 $data = [];
 295             } else {
 296                 die "Can't parse: $_";
 297             }
 298         }
 299
 300         elsif (/^\[/) {
 301             if ($method) {
 302                 push(@$data, $_);
 303             } else {
 304                 # ignore extraneous GC notices
 305             }
 306         }
 307
 308         else {
 309             # die "Can't parse: $_";
 310         }
 311     }
 312
 313     die "$method was begun but not finished" if ($method);
 314
 315     @results;
 316 }
 317
 318 sub debug  {
 319   my $message;
 320   if($DEBUG != 0) {
 321     foreach $message (@_) {
 322       print STDERR "$message";
 323     }
 324   }
 325 }
 326
 327 sub measure1Alan {
 328   #Added here, was global
 329   my $CALIBRATE = 2; # duration in seconds for initial calibration
 330
 331     my $method = shift;
 332     my $pat = shift;
 333     my $iterCount = shift; # actually might be -seconds/pass
 334
 335     out("<P>Measuring $method using $pat, ");
 336     if ($iterCount > 0) {
 337         out("$iterCount iterations/pass, $NUMPASSES passes</P>\n");
 338     } else {
 339         out(-$iterCount, " seconds/pass, $NUMPASSES passes</P>\n");
 340     }
 341
 342     # is $iterCount actually -seconds?
 343     if ($iterCount < 0) {
 344
 345         # calibrate: estimate ms/iteration
 346         print "Calibrating...";
 347         my @t = callJava($method, $pat, -$CALIBRATE);
 348         print "done.\n";
 349
 350         my @data = split(/\s+/, $t[0]->[2]);
 351         my $timePerIter = 1.0e-3 * $data[0] / $data[2];
 352
 353         # determine iterations/pass
 354         $iterCount = int(-$iterCount / $timePerIter + 0.5);
 355
 356         out("<P>Calibration pass ($CALIBRATE sec): ");
 357         out("$data[0] ms, ");
 358         out("$data[2] iterations = ");
 359         out(formatSeconds(4, $timePerIter), "/iteration<BR>\n");
 360     }
 361
 362     # run passes
 363     print "Measuring $iterCount iterations x $NUMPASSES passes...";
 364     my @t = callJava($method, $pat, "$iterCount " x $NUMPASSES);
 365     print "done.\n";
 366     my @ms = ();
 367     my @b; # scratch
 368     for my $a (@t) {
 369         # $a->[0]: method name, corresponds to $method
 370         # $a->[1]: 'begin' data, == $iterCount
 371         # $a->[2]: 'end' data, of the form <ms> <eventsPerIter>
 372         # $a->[3...]: gc messages from JVM during pass
 373         @b = split(/\s+/, $a->[2]);
 374         push(@ms, $b[0]);
 375     }
 376     my $eventsPerIter = $b[1];
 377
 378     out("Iterations per pass: $iterCount<BR>\n");
 379     out("Events per iteration: $eventsPerIter<BR>\n");
 380
 381     my @ms_str = @ms;
 382     $ms_str[0] .= " (discarded)" if (@ms_str > 1);
 383     out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
 384
 385     ($iterCount, $eventsPerIter, @ms);
 386 }
 387
 388
 389 1;
 390
 391 #eof