Home | History | Annotate | Download | only in perldriver 
      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
    395