use XML::LibXML;
use lib '.';
use Dataset;
my $OS=$^O;
my $CLASSPATH;
if ($OS eq "linux" || $OS eq "darwin") {
$CLASSPATH="../icu4j.jar:../tools/misc/out/lib/icu4j-tools.jar:out/bin";
} else {
$CLASSPATH="../icu4j.jar;../tools/misc/out/lib/icu4j-tools.jar;out/bin";
}
my @METHODS = (
['TestJDKConstruction', 'TestICUConstruction'],
['TestJDKParse', 'TestICUParse'],
['TestJDKFormat', 'TestICUFormat']
);
my @OPTIONS = (
[ "en_US", "dddd MMM yyyy", "15 Jan 2007"],
[ "sw_KE", "dddd MMM yyyy", "15 Jan 2007"],
[ "en_US", "HH:mm", "13:13"],
[ "en_US", "HH:mm zzzz", "13:13 Pacific Standard Time"],
[ "en_US", "HH:mm z", "13:13 PST"],
[ "en_US", "HH:mm Z", "13:13 -0800"],
);
my $THREADS;
my $CALIBRATE = 2;
my $DURATION = 10;
my $NUMPASSES = 4;
my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
my $PLUS_MINUS = "±";
if ($NUMPASSES < 3) {
die "Need at least 3 passes. One is discarded (JIT warmup) and need two to have 1 degree of freedom (t distribution).";
}
foreach my $arg ($#ARGV >= 0 ? @ARGV : "1") {
$THREADS = $arg;
main();
}
sub main {
my $testclass = 'com.ibm.icu.dev.test.perf.DateFormatPerformanceTest';
my $doc = XML::LibXML::Document->new('1.0', 'utf-8');
my $root = $doc->createElement("perfTestResults");
my @shortNames = ( "open" , "parse", "fmt");
my $index=0;
for my $methodPair (@METHODS) {
my $testMethod = $methodPair->[0];
my $baselineMethod = $methodPair->[1];
my $testname = $shortNames[$index];
$index++;
$OUT = '';
my $patternCounter=1;
for my $pat (@OPTIONS) {
my $t = measure2($testclass, $testMethod, $pat, -$DURATION);
my $testResult = $t->getMean();
my $jdkElement = $doc->createElement("perfTestResult");
my $testName = "DateFmt-$testname-pat$patternCounter-JDK";
$jdkElement->setAttribute("test" => $testName);
$jdkElement->setAttribute("iterations" => 1);
$jdkElement->setAttribute("time" => $testResult);
$root->appendChild($jdkElement);
my $b = measure2($testclass, $baselineMethod, $pat, -$DURATION);
my $baseResult = $b->getMean();
my $icuElement = $doc->createElement("perfTestResult");
my $testName = "DateFmt-$testname-pat$patternCounter";
$patternCounter++;
$icuElement->setAttribute("test"=> $testName);
$icuElement->setAttribute("iterations" => 1);
$icuElement->setAttribute("time" => $baseResult);
$root->appendChild($icuElement);
}
}
my $testclass = 'com.ibm.icu.dev.test.perf.DecimalFormatPerformanceTest';
my @OPTIONS = (
[ "en_US", "#,###.##", "1,234.56"],
[ "de_DE", "#,###.##", "1.234,56"],
);
my $index=0;
for my $methodPair (@METHODS) {
my $testMethod = $methodPair->[0];
my $baselineMethod = $methodPair->[1];
my $testname = $shortNames[$index];
$index++;
for my $pat (@OPTIONS) {
my $patternName = $pat->[0];
my $t = measure2($testclass, $testMethod, $pat, -$DURATION);
my $testResult = $t->getMean();
my $jdkElement = $doc->createElement("perfTestResult");
my $testName = "NumFmt-$testname-$patternName-JDK";
$jdkElement->setAttribute("test" => $testName);
$jdkElement->setAttribute("iterations"=>1);
$jdkElement->setAttribute("time" => $testResult);
$root->appendChild($jdkElement);
my $b = measure2($testclass, $baselineMethod, $pat, -$DURATION);
my $baseResult = $b->getMean();
my $icuElement = $doc->createElement("perfTestResult");
my $testName = "NumFmt-$testname-$patternName";
$icuElement->setAttribute("test"=> $testName);
$icuElement->setAttribute("iterations"=>1);
$icuElement->setAttribute("time" => $baseResult);
$root->appendChild($icuElement);
}
}
%dataFiles = (
"en_US", "TestNames_Latin.txt",
"da_DK", "TestNames_Latin.txt",
"de_DE", "TestNames_Latin.txt",
"de__PHONEBOOK", "TestNames_Latin.txt",
"fr_FR", "TestNames_Latin.txt",
"ja_JP", "TestNames_Latin.txt TestNames_Japanese_h.txt TestNames_Japanese_k.txt TestNames_Asian.txt",
"zh_CN", "TestNames_Latin.txt TestNames_Chinese.txt",
"zh_TW", "TestNames_Latin.txt TestNames_Chinese.txt",
"zh__PINYIN", "TestNames_Latin.txt TestNames_Chinese.txt",
"ru_RU", "TestNames_Latin.txt TestNames_Russian.txt",
"th", "TestNames_Latin.txt TestNames_Thai.txt",
"ko_KR", "TestNames_Latin.txt TestNames_Korean.txt",
);
foreach $locale (
"en_US",
"da_DK",
"de_DE",
"de__PHONEBOOK",
"fr_FR",
"ja_JP",
"zh_CN",
"zh_TW",
"zh__PINYIN",
"ko_KR",
"ru_RU",
"th",
)
{
$ff = $dataFiles{$locale};
@ff = split(/[\s]+/, $ff);
$counter = 1;
foreach $data (@ff) {
$iStrCol = `java -classpath $CLASSPATH com.ibm.icu.dev.test.perf.CollationPerformanceTest -terse -file data/collation/$data -locale $locale -loop 1000 -binsearch`;
print "java -classpath $CLASSPATH com.ibm.icu.dev.test.perf.CollationPerformanceTest -terse -file data/collation/$data -locale $locale -loop 1000 -binsearch\n";
$iStrCol =~s/[,\s]*//g;
doKeyTimes("java -classpath $CLASSPATH com.ibm.icu.dev.test.perf.CollationPerformanceTest -terse -file data/collation/$data -locale $locale -loop 1000 -keygen",
my $iKeyGen, my $iKeyLen);
$wStrCol = $wKeyGen = $wKeyLen = 0;
my $wStrCol = `java -classpath $CLASSPATH com.ibm.icu.dev.test.perf.CollationPerformanceTest -terse -file data/collation/$data -locale $locale -loop 1000 -binsearch -java`;
$wStrCol =~s/[,\s]*//g;
doKeyTimes("java -classpath $CLASSPATH com.ibm.icu.dev.test.perf.CollationPerformanceTest -terse -file data/collation/$data -locale $locale -loop 1000 -keygen -java",
$wKeyGen, $wKeyLen);
$collDiff = $keyGenDiff = $keyLenDiff = 0;
if ($wKeyLen > 0) {
$collDiff = (($wStrCol - $iStrCol) / $iStrCol) * 100;
$keyGenDiff = (($wKeyGen - $iKeyGen) / $iKeyGen) * 100;
$keyLenDiff = (($wKeyLen - $iKeyLen) / $iKeyLen) * 100;
}
my $ICU = $doc->createElement("perfTestResult");
my $testname = "Coll-$locale-data$counter-StrCol";
$ICU->setAttribute("test"=> $testname);
$ICU->setAttribute("iterations"=>1000);
$ICU->setAttribute("time"=> $iStrCol);
$root->appendChild($ICU);
my $Key = $doc->createElement("perfTestResult");
my $testname = "Coll-$locale-data$counter-keyGen";
$Key->setAttribute("test"=> $testname);
$Key->setAttribute("iterations"=>1000);
$Key->setAttribute("time"=>$iKeyGen);
$root->appendChild($Key);
my $JDK = $doc->createElement("perfTestResult");
my $testname = "Coll-$locale-data$counter-StrCol-JDK";
$JDK->setAttribute("test"=>$testname);
$JDK->setAttribute("iterations"=>1000);
$JDK->setAttribute("time"=>$wStrCol);
$root->appendChild($JDK);
my $Key = $doc->createElement("perfTestResult");
my $testname = "Coll-$locale-data$counter-keyGen-JDK";
$Key->setAttribute("test"=>$testname);
$Key->setAttribute("iterations"=>1000);
$Key->setAttribute("time"=>$wKeyGen);
$root->appendChild($Key);
$counter++;
}
}
$doc->setDocumentElement($root);
open my $out_fh, '>', "perf.xml";
print {$out_fh} $doc->toString;
}
sub out {
$OUT .= join('', @_);
}
sub measure2 {
my @data = measure1(@_);
my $iterPerPass = shift(@data);
my $eventPerIter = shift(@data);
shift(@data) if (@data > 1);
my $ds = Dataset->new(@data);
$ds->setScale(1.0e-3 / ($iterPerPass * $eventPerIter));
$ds;
}
sub measure1 {
my $testclass = shift;
my $method = shift;
my $pat = shift;
my $iterCount = shift;
if ($iterCount < 0) {
print "Calibrating...";
my @t = callJava($testclass, $method, $pat, -$CALIBRATE, 1);
print "done.\n";
my @data = split(/\s+/, $t[0]->[2]);
$data[0] *= 1.0e+3;
my $timePerIter = 1.0e-3 * $data[0] / $data[1];
$iterCount = int(-$iterCount / $timePerIter + 0.5);
}
print "Measuring $iterCount iterations x $NUMPASSES passes...";
my @t = callJava($testclass, $method, $pat, $iterCount, $NUMPASSES);
print "done.\n";
my @ms = ();
my @b;
for my $a (@t) {
@b = split(/\s+/, $a->[2]);
push(@ms, $b[0] * 1.0e+3);
}
my $eventsPerIter = $b[2];
my @ms_str = @ms;
$ms_str[0] .= " (discarded)" if (@ms_str > 1);
($iterCount, $eventsPerIter, @ms);
}
sub callJava {
my $testclass = shift;
my $method = shift;
my $pat = shift;
my $n = shift;
my $passes = shift;
my $n = ($n < 0) ? "-t ".(-$n) : "-i ".$n;
my $cmd = "java -classpath $CLASSPATH $testclass $method $n -p $passes -L @$pat[0] \"@$pat[1]\" \"@$pat[2]\" -r $THREADS";
print "[$cmd]\n";
open(PIPE, "$cmd|") or die "Can't run \"$cmd\"";
my @out;
while (<PIPE>) {
push(@out, $_);
}
close(PIPE) or die "Java failed: \"$cmd\"";
@out = grep(!/^\#/, @out);
my @results;
my $method = '';
my $data = [];
foreach (@out) {
next unless (/\S/);
if (/^=\s*(\w+)\s*(\w+)\s*(.*)/) {
my ($m, $state, $d) = ($1, $2, $3);
if ($state eq 'begin') {
die "$method was begun but not finished" if ($method);
$method = $m;
push(@$data, $d);
push(@$data, '');
} elsif ($state eq 'end') {
if ($m ne $method) {
die "$method end does not match: $_";
}
$data->[1] = $d;
unshift(@$data, $method);
push(@results, $data);
$method = '';
$data = [];
} else {
die "Can't parse: $_";
}
}
elsif (/^\[/) {
if ($method) {
push(@$data, $_);
} else {
}
}
else {
die "Can't parse: $_";
}
}
die "$method was begun but not finished" if ($method);
@results;
}
sub doKeyTimes($$$) {
local($x) = `$_[0]`;
($_[1], $_[2]) = split(/\,/, $x);
}