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