source/test/perf/perldriver/PerfFramework.pm

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