jars/icu4j-52_1/perf-tests/perldriver/PerfFramework4j.pm

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