392 lines
10 KiB
Perl
392 lines
10 KiB
Perl
#!/usr/local/bin/perl
|
|
# ***********************************************************************
|
|
# * COPYRIGHT:
|
|
# * Copyright (c) 2002-2008, International Business Machines Corporation
|
|
# * and others. All Rights Reserved.
|
|
# ***********************************************************************
|
|
|
|
use strict;
|
|
|
|
#use Dataset;
|
|
use Format;
|
|
use Output;
|
|
|
|
my $VERBOSE = 0;
|
|
my $DEBUG = 1;
|
|
my $start_l = ""; #formatting help
|
|
my $end_l = "";
|
|
my @testArgs; # different kinds of tests we want to do
|
|
my $datadir = "data";
|
|
my $extraArgs; # stuff that always gets passed to the test program
|
|
|
|
|
|
my $iterCount = 0;
|
|
my $NUMPASSES = 4;
|
|
my $TIME = 2;
|
|
my $ITERATIONS; #Added by Doug
|
|
my $DATADIR;
|
|
|
|
sub setupOptions {
|
|
my %options = %{shift @_};
|
|
|
|
if($options{"time"}) {
|
|
$TIME = $options{"time"};
|
|
}
|
|
|
|
if($options{"passes"}) {
|
|
$NUMPASSES = $options{"passes"};
|
|
}
|
|
|
|
if($options{"dataDir"}) {
|
|
$DATADIR = $options{"dataDir"};
|
|
}
|
|
|
|
# Added by Doug
|
|
if ($options{"iterations"}) {
|
|
$ITERATIONS = $options{"iterations"};
|
|
}
|
|
}
|
|
|
|
sub runTests {
|
|
my $options = shift;
|
|
my @programs;
|
|
my $tests = shift;
|
|
my %datafiles;
|
|
if($#_ >= 0) { # maybe no files/locales
|
|
my $datafiles = shift;
|
|
if($datafiles) {
|
|
%datafiles = %{$datafiles};
|
|
}
|
|
}
|
|
setupOutput($options);
|
|
setupOptions($options);
|
|
|
|
my($locale, $iter, $data, $program, $args, $variable);
|
|
#
|
|
# Outer loop runs through the locales to test
|
|
#
|
|
if (%datafiles) {
|
|
foreach $locale (sort keys %datafiles ) {
|
|
foreach $data (@{ $datafiles{$locale} }) {
|
|
closeTable;
|
|
my $locdata = "";
|
|
if(!($locale eq "")) {
|
|
$locdata = "<b>Locale:</b> $locale<br>";
|
|
}
|
|
$locdata .= "<b>Datafile:</b> $data<br>";
|
|
startTest($locdata);
|
|
|
|
if($DATADIR) {
|
|
compareLoop ($tests, $locale, $DATADIR."/".$data);
|
|
} else {
|
|
compareLoop ($tests, $locale, $data);
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
compareLoop($tests);
|
|
}
|
|
closeOutput();
|
|
}
|
|
|
|
sub compareLoop {
|
|
my $tests = shift;
|
|
#my @tests = @{$tests};
|
|
my %tests = %{$tests};
|
|
my $locale = shift;
|
|
my $datafile = shift;
|
|
my $locAndData = "";
|
|
if($locale) {
|
|
$locAndData .= " -L $locale";
|
|
}
|
|
if($datafile) {
|
|
$locAndData .= " -f $datafile";
|
|
}
|
|
|
|
my $args;
|
|
my ($i, $j, $aref);
|
|
foreach $i ( sort keys %tests ) {
|
|
debug("Test: $i\n");
|
|
$aref = $tests{$i};
|
|
my @timedata;
|
|
my @iterPerPass;
|
|
my @noopers;
|
|
my @noevents;
|
|
|
|
my $program;
|
|
my @argsAndTest;
|
|
for $j ( 0 .. $#{$aref} ) {
|
|
# first we calibrate. Use time from somewhere
|
|
# first test is used for calibration
|
|
($program, @argsAndTest) = split(/\ /, @{ $tests{$i} }[$j]);
|
|
#Modified by Doug
|
|
my $commandLine;
|
|
if ($ITERATIONS) {
|
|
$commandLine = "$program -i $ITERATIONS -p $NUMPASSES $locAndData @argsAndTest";
|
|
} else {
|
|
$commandLine = "$program -t $TIME -p $NUMPASSES $locAndData @argsAndTest";
|
|
}
|
|
#my $commandLine = "$program -i 5 -p $NUMPASSES $locAndData @argsAndTest";
|
|
my @res = measure1($commandLine);
|
|
store("$i, $program @argsAndTest", @res);
|
|
|
|
push(@iterPerPass, shift(@res));
|
|
push(@noopers, shift(@res));
|
|
my @data = @{ shift(@res) };
|
|
if($#res >= 0) {
|
|
push(@noevents, shift(@res));
|
|
}
|
|
|
|
|
|
shift(@data) if (@data > 1); # discard first run
|
|
|
|
#debug("data is @data\n");
|
|
my $ds = Dataset->new(@data);
|
|
|
|
push(@timedata, $ds);
|
|
}
|
|
|
|
outputRow($i, \@iterPerPass, \@noopers, \@timedata, \@noevents);
|
|
}
|
|
|
|
}
|
|
|
|
#---------------------------------------------------------------------
|
|
# Measure a given test method with a give test pattern using the
|
|
# global run parameters.
|
|
#
|
|
# @param the method to run
|
|
# @param the pattern defining characters to test
|
|
# @param if >0 then the number of iterations per pass. If <0 then
|
|
# (negative of) the number of seconds per pass.
|
|
#
|
|
# @return array of:
|
|
# [0] iterations per pass
|
|
# [1] events per iteration
|
|
# [2..] ms reported for each pass, in order
|
|
#
|
|
sub measure1 {
|
|
# run passes
|
|
my @t = callProg(shift); #"$program $args $argsAndTest");
|
|
my @ms = ();
|
|
my @b; # scratch
|
|
for my $a (@t) {
|
|
# $a->[0]: method name, corresponds to $method
|
|
# $a->[1]: 'begin' data, == $iterCount
|
|
# $a->[2]: 'end' data, of the form <ms> <eventsPerIter>
|
|
# $a->[3...]: gc messages from JVM during pass
|
|
@b = split(/\s+/, $a->[2]);
|
|
#push(@ms, $b[0]);
|
|
push(@ms, shift(@b));
|
|
}
|
|
my $iterCount = shift(@b);
|
|
my $operationsPerIter = shift(@b);
|
|
my $eventsPerIter;
|
|
if($#b >= 0) {
|
|
$eventsPerIter = shift(@b);
|
|
}
|
|
|
|
# out("Iterations per pass: $iterCount<BR>\n");
|
|
# out("Events per iteration: $eventsPerIter<BR>\n");
|
|
# debug("Iterations per pass: $iterCount<BR>\n");
|
|
# if($eventsPerIter) {
|
|
# debug("Events per iteration: $eventsPerIter<BR>\n");
|
|
# }
|
|
|
|
my @ms_str = @ms;
|
|
$ms_str[0] .= " (discarded)" if (@ms_str > 1);
|
|
# out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
|
|
debug("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
|
|
if($eventsPerIter) {
|
|
($iterCount, $operationsPerIter, \@ms, $eventsPerIter);
|
|
} else {
|
|
($iterCount, $operationsPerIter, \@ms);
|
|
}
|
|
}
|
|
|
|
|
|
|
|
#---------------------------------------------------------------------
|
|
# Measure a given test method with a give test pattern using the
|
|
# global run parameters.
|
|
#
|
|
# @param the method to run
|
|
# @param the pattern defining characters to test
|
|
# @param if >0 then the number of iterations per pass. If <0 then
|
|
# (negative of) the number of seconds per pass.
|
|
#
|
|
# @return a Dataset object, scaled by iterations per pass and
|
|
# events per iteration, to give time per event
|
|
#
|
|
sub measure2 {
|
|
my @res = measure1(@_);
|
|
my $iterPerPass = shift(@res);
|
|
my $operationsPerIter = shift(@res);
|
|
my @data = @{ shift(@res) };
|
|
my $eventsPerIter = shift(@res);
|
|
|
|
|
|
shift(@data) if (@data > 1); # discard first run
|
|
|
|
my $ds = Dataset->new(@data);
|
|
#$ds->setScale(1.0e-3 / ($iterPerPass * $operationsPerIter));
|
|
($ds, $iterPerPass, $operationsPerIter, $eventsPerIter);
|
|
}
|
|
|
|
|
|
#---------------------------------------------------------------------
|
|
# Invoke program and capture results, passing it the given parameters.
|
|
#
|
|
# @param the method to run
|
|
# @param the number of iterations, or if negative, the duration
|
|
# in seconds. If more than on pass is desired, pass in
|
|
# a string, e.g., "100 100 100".
|
|
# @param the pattern defining characters to test
|
|
#
|
|
# @return an array of results. Each result is an array REF
|
|
# describing one pass. The array REF contains:
|
|
# ->[0]: The method name as reported
|
|
# ->[1]: The params on the '= <meth> begin ...' line
|
|
# ->[2]: The params on the '= <meth> end ...' line
|
|
# ->[3..]: GC messages from the JVM, if any
|
|
#
|
|
sub callProg {
|
|
my $cmd = shift;
|
|
#my $pat = shift;
|
|
#my $n = shift;
|
|
|
|
#my $cmd = "java -cp c:\\dev\\myicu4j\\classes $TESTCLASS $method $n $pat";
|
|
debug( "[$cmd]\n"); # for debugging
|
|
open(PIPE, "$cmd|") or die "Can't run \"$cmd\"";
|
|
my @out;
|
|
while (<PIPE>) {
|
|
push(@out, $_);
|
|
}
|
|
close(PIPE) or die "Program failed: \"$cmd\"";
|
|
|
|
@out = grep(!/^\#/, @out); # filter out comments
|
|
|
|
#debug( "[", join("\n", @out), "]\n");
|
|
|
|
my @results;
|
|
my $method = '';
|
|
my $data = [];
|
|
foreach (@out) {
|
|
next unless (/\S/);
|
|
|
|
if (/^=\s*(\w+)\s*(\w+)\s*(.*)/) {
|
|
my ($m, $state, $d) = ($1, $2, $3);
|
|
#debug ("$_ => [[$m $state !!!$d!!! $data ]]\n");
|
|
if ($state eq 'begin') {
|
|
die "$method was begun but not finished" if ($method);
|
|
$method = $m;
|
|
push(@$data, $d);
|
|
push(@$data, ''); # placeholder for end data
|
|
} elsif ($state eq 'end') {
|
|
if ($m ne $method) {
|
|
die "$method end does not match: $_";
|
|
}
|
|
$data->[1] = $d; # insert end data at [1]
|
|
#debug( "#$method:", join(";",@$data), "\n");
|
|
unshift(@$data, $method); # add method to start
|
|
push(@results, $data);
|
|
$method = '';
|
|
$data = [];
|
|
} else {
|
|
die "Can't parse: $_";
|
|
}
|
|
}
|
|
|
|
elsif (/^\[/) {
|
|
if ($method) {
|
|
push(@$data, $_);
|
|
} else {
|
|
# ignore extraneous GC notices
|
|
}
|
|
}
|
|
|
|
else {
|
|
# die "Can't parse: $_";
|
|
}
|
|
}
|
|
|
|
die "$method was begun but not finished" if ($method);
|
|
|
|
@results;
|
|
}
|
|
|
|
sub debug {
|
|
my $message;
|
|
if($DEBUG != 0) {
|
|
foreach $message (@_) {
|
|
print STDERR "$message";
|
|
}
|
|
}
|
|
}
|
|
|
|
sub measure1Alan {
|
|
#Added here, was global
|
|
my $CALIBRATE = 2; # duration in seconds for initial calibration
|
|
|
|
my $method = shift;
|
|
my $pat = shift;
|
|
my $iterCount = shift; # actually might be -seconds/pass
|
|
|
|
out("<P>Measuring $method using $pat, ");
|
|
if ($iterCount > 0) {
|
|
out("$iterCount iterations/pass, $NUMPASSES passes</P>\n");
|
|
} else {
|
|
out(-$iterCount, " seconds/pass, $NUMPASSES passes</P>\n");
|
|
}
|
|
|
|
# is $iterCount actually -seconds?
|
|
if ($iterCount < 0) {
|
|
|
|
# calibrate: estimate ms/iteration
|
|
print "Calibrating...";
|
|
my @t = callJava($method, $pat, -$CALIBRATE);
|
|
print "done.\n";
|
|
|
|
my @data = split(/\s+/, $t[0]->[2]);
|
|
my $timePerIter = 1.0e-3 * $data[0] / $data[2];
|
|
|
|
# determine iterations/pass
|
|
$iterCount = int(-$iterCount / $timePerIter + 0.5);
|
|
|
|
out("<P>Calibration pass ($CALIBRATE sec): ");
|
|
out("$data[0] ms, ");
|
|
out("$data[2] iterations = ");
|
|
out(formatSeconds(4, $timePerIter), "/iteration<BR>\n");
|
|
}
|
|
|
|
# run passes
|
|
print "Measuring $iterCount iterations x $NUMPASSES passes...";
|
|
my @t = callJava($method, $pat, "$iterCount " x $NUMPASSES);
|
|
print "done.\n";
|
|
my @ms = ();
|
|
my @b; # scratch
|
|
for my $a (@t) {
|
|
# $a->[0]: method name, corresponds to $method
|
|
# $a->[1]: 'begin' data, == $iterCount
|
|
# $a->[2]: 'end' data, of the form <ms> <eventsPerIter>
|
|
# $a->[3...]: gc messages from JVM during pass
|
|
@b = split(/\s+/, $a->[2]);
|
|
push(@ms, $b[0]);
|
|
}
|
|
my $eventsPerIter = $b[1];
|
|
|
|
out("Iterations per pass: $iterCount<BR>\n");
|
|
out("Events per iteration: $eventsPerIter<BR>\n");
|
|
|
|
my @ms_str = @ms;
|
|
$ms_str[0] .= " (discarded)" if (@ms_str > 1);
|
|
out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
|
|
|
|
($iterCount, $eventsPerIter, @ms);
|
|
}
|
|
|
|
|
|
1;
|
|
|
|
#eof
|