| #!/usr/local/bin/perl | 
 | # ******************************************************************************* | 
 | # * 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 'src/com/ibm/icu/dev/test/perf'; | 
 | 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 dirctly 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 <ms> <loops> <eventsPerIter> | 
 |         # $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 '= <meth> begin ...' line | 
 | #         ->[2]: The params on the '= <meth> 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 (<PIPE>) { | 
 |         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 |