#!/usr/local/bin/perl # * © 2016 and later: Unicode, Inc. and others. # * License & terms of use: http://www.unicode.org/copyright.html # ******************************************************************************* # * Copyright (C) 2002-2012 International Business Machines Corporation and * # * others. All Rights Reserved. * # ******************************************************************************* use XML::LibXML; # Assume we are running within the icu4j root directory 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"; } #--------------------------------------------------------------------- # Methods to be tested. Each pair represents a test method and # a baseline method which is used for comparison. my @METHODS = ( ['TestJDKConstruction', 'TestICUConstruction'], ['TestJDKParse', 'TestICUParse'], ['TestJDKFormat', 'TestICUFormat'] ); # Patterns which define the set of characters used for testing. my @OPTIONS = ( # locale pattern date string [ "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; # number of threads (input from command-line args) my $CALIBRATE = 2; # duration in seconds for initial calibration my $DURATION = 10; # duration in seconds for each pass my $NUMPASSES = 4; # number of passes. If > 1 then the first pass # is discarded as a JIT warm-up pass. 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)."; } # run all tests with the specified number of threads from command-line input # (if there is no arguments, use $THREADS = 1) foreach my $arg ($#ARGV >= 0 ? @ARGV : "1") { $THREADS = $arg; main(); } #--------------------------------------------------------------------- sub main { #-----------DATE FORMAT PERFORMANCE TESTS----------------------------- my $testclass = 'com.ibm.icu.dev.test.perf.DateFormatPerformanceTest'; #my $threads = ($THREADS > 1) ? "($THREADS threads)" : ""; my $doc = XML::LibXML::Document->new('1.0', 'utf-8'); my $root = $doc->createElement("perfTestResults"); # my $raw = ""; 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) { # measure the test method 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); # measure baseline method 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); } } #------------------DECIMAL FORMAT TESTS--------------------------------- my $testclass = 'com.ibm.icu.dev.test.perf.DecimalFormatPerformanceTest'; my @OPTIONS = ( # locale pattern date string [ "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]; # measure the test method 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); # measure baseline method 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); } } #----------------COLLATION PERFORMANCE TESTS--------------------------_ %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", ); # Outer loop runs through the locales to test # (Edit this list directly to make changes) # 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", ) { # # Inner loop runs over the set of data files specified for each locale. # (Edit the %datafiles initialization, above, to make changes. # $ff = $dataFiles{$locale}; @ff = split(/[\s]+/, $ff); $counter = 1; foreach $data (@ff) { # # Run ICU Test for this (locale, data file) pair. # $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; # whack off the leading " ," in the returned result. 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); # # Run Windows test for this (locale, data file) pair. Only do if # we are not on Windows 98/ME and we hava a windows langID # for the locale. # $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; # whack off the leading " ," in the returned result. 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"; #write the results corresponding to this local,data pair $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++; } } #----------WRITE RESULTS TO perf.xml----------------------- $doc->setDocumentElement($root); open my $out_fh, '>', "perf.xml"; print {$out_fh} $doc->toString; } #--------------------------------------------------------------------- # Append text to the global variable $OUT sub out { $OUT .= join('', @_); } #--------------------------------------------------------------------- # 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 @data = measure1(@_); my $iterPerPass = shift(@data); my $eventPerIter = shift(@data); shift(@data) if (@data > 1); # discard first run my $ds = Dataset->new(@data); $ds->setScale(1.0e-3 / ($iterPerPass * $eventPerIter)); $ds; } #--------------------------------------------------------------------- # 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 { my $testclass = shift; my $method = shift; my $pat = shift; my $iterCount = shift; # actually might be -seconds/pass # is $iterCount actually -seconds/pass? if ($iterCount < 0) { # calibrate: estimate ms/iteration 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]; # determine iterations/pass $iterCount = int(-$iterCount / $timePerIter + 0.5); } # run passes print "Measuring $iterCount iterations x $NUMPASSES passes..."; my @t = callJava($testclass, $method, $pat, $iterCount, $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 # $a->[3...]: gc messages from JVM during pass @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); } #--------------------------------------------------------------------- # Invoke java to run $TESTCLASS, 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 '= begin ...' line # ->[2]: The params on the '= end ...' line # ->[3..]: GC messages from the JVM, if any # 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"; # for debugging open(PIPE, "$cmd|") or die "Can't run \"$cmd\""; my @out; while () { push(@out, $_); } close(PIPE) or die "Java failed: \"$cmd\""; @out = grep(!/^\#/, @out); # filter out comments #print "[", 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); #print "$_ => [[$m $state $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] #print "#$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; } #----------------------------------------------------------------------------------- # doKeyGenTimes($Command_to_run, $time, $key_length) # Do a key-generation test and return the time and key length/char values. # sub doKeyTimes($$$) { # print "$_[0]\n"; local($x) = `$_[0]`; # execute the collperf command. ($_[1], $_[2]) = split(/\,/, $x); # collperf returns "time, keylength" string. } #eof