1#!/usr/local/bin/perl
2# * © 2016 and later: Unicode, Inc. and others.
3# * License & terms of use: http://www.unicode.org/copyright.html
4# *******************************************************************************
5# * Copyright (C) 2002-2012 International Business Machines Corporation and     *
6# * others. All Rights Reserved.                                                *
7# *******************************************************************************
8
9use XML::LibXML;
10
11# Assume we are running within the icu4j root directory
12use lib 'src/com/ibm/icu/dev/test/perf';
13use Dataset;
14my $OS=$^O;
15
16my $CLASSPATH;
17if ($OS eq "linux" || $OS eq "darwin") {
18	$CLASSPATH="../icu4j.jar:../tools/misc/out/lib/icu4j-tools.jar:out/bin";
19} else {
20	$CLASSPATH="../icu4j.jar;../tools/misc/out/lib/icu4j-tools.jar;out/bin";
21}
22#---------------------------------------------------------------------
23
24# Methods to be tested.  Each pair represents a test method and
25# a baseline method which is used for comparison.
26my @METHODS  = (
27                 ['TestJDKConstruction',     'TestICUConstruction'],
28                 ['TestJDKParse',            'TestICUParse'],
29                 ['TestJDKFormat',           'TestICUFormat']
30               );
31# Patterns which define the set of characters used for testing.
32my @OPTIONS = (
33#                 locale    pattern              date string
34                [ "en_US",  "dddd MMM yyyy",     "15 Jan 2007"],
35                [ "sw_KE",  "dddd MMM yyyy",     "15 Jan 2007"],
36                [ "en_US",  "HH:mm",             "13:13"],
37                [ "en_US",  "HH:mm zzzz",        "13:13 Pacific Standard Time"],
38                [ "en_US",  "HH:mm z",           "13:13 PST"],
39                [ "en_US",  "HH:mm Z",           "13:13 -0800"],
40              );
41
42my $THREADS;        # number of threads (input from command-line args)
43my $CALIBRATE = 2;  # duration in seconds for initial calibration
44my $DURATION  = 10; # duration in seconds for each pass
45my $NUMPASSES = 4;  # number of passes.  If > 1 then the first pass
46                    # is discarded as a JIT warm-up pass.
47
48my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
49
50my $PLUS_MINUS = "±";
51
52if ($NUMPASSES < 3) {
53    die "Need at least 3 passes.  One is discarded (JIT warmup) and need two to have 1 degree of freedom (t distribution).";
54}
55
56
57# run all tests with the specified number of threads from command-line input
58# (if there is no arguments, use $THREADS = 1)
59foreach my $arg ($#ARGV >= 0 ? @ARGV : "1") {
60  $THREADS = $arg;
61  main();
62}
63
64
65#---------------------------------------------------------------------
66sub main {
67
68#-----------DATE FORMAT PERFORMANCE TESTS-----------------------------
69    my $testclass = 'com.ibm.icu.dev.test.perf.DateFormatPerformanceTest';
70    #my $threads = ($THREADS > 1) ? "($THREADS threads)" : "";
71
72    my $doc = XML::LibXML::Document->new('1.0', 'utf-8');
73    my $root = $doc->createElement("perfTestResults");
74
75 #   my $raw = "";
76    my @shortNames = ( "open" , "parse", "fmt");
77    my $index=0;
78
79    for my $methodPair (@METHODS) {
80
81        my $testMethod = $methodPair->[0];
82        my $baselineMethod = $methodPair->[1];
83	my $testname = $shortNames[$index];
84	$index++;
85
86        $OUT = '';
87	my $patternCounter=1;
88
89        for my $pat (@OPTIONS) {
90
91            # measure the test method
92            my $t = measure2($testclass, $testMethod, $pat, -$DURATION);
93	    my $testResult = $t->getMean();
94	    my $jdkElement = $doc->createElement("perfTestResult");
95	    my $testName = "DateFmt-$testname-pat$patternCounter-JDK";
96	    $jdkElement->setAttribute("test" => $testName);
97	    $jdkElement->setAttribute("iterations" => 1);
98	    $jdkElement->setAttribute("time" => $testResult);
99	    $root->appendChild($jdkElement);
100
101            # measure baseline method
102            my $b = measure2($testclass, $baselineMethod, $pat, -$DURATION);
103            my $baseResult = $b->getMean();
104	    my $icuElement = $doc->createElement("perfTestResult");
105	    my $testName = "DateFmt-$testname-pat$patternCounter";
106	    $patternCounter++;
107	    $icuElement->setAttribute("test"=> $testName);
108 	    $icuElement->setAttribute("iterations" => 1);
109	    $icuElement->setAttribute("time" => $baseResult);
110	    $root->appendChild($icuElement);
111
112       }
113    }
114
115#------------------DECIMAL FORMAT TESTS---------------------------------
116
117    my $testclass = 'com.ibm.icu.dev.test.perf.DecimalFormatPerformanceTest';
118    my @OPTIONS = (
119#		locale	    pattern	date string
120		[ "en_US", "#,###.##", "1,234.56"],
121		[ "de_DE", "#,###.##", "1.234,56"],
122		);
123    my $index=0;
124    for my $methodPair (@METHODS) {
125
126        my $testMethod = $methodPair->[0];
127        my $baselineMethod = $methodPair->[1];
128	my $testname = $shortNames[$index];
129	$index++;
130
131
132        for my $pat (@OPTIONS) {
133	       my $patternName = $pat->[0];
134
135            # measure the test method
136            my $t = measure2($testclass, $testMethod, $pat, -$DURATION);
137	    my $testResult = $t->getMean();
138	    my $jdkElement = $doc->createElement("perfTestResult");
139	    my $testName = "NumFmt-$testname-$patternName-JDK";
140	    $jdkElement->setAttribute("test" => $testName);
141	    $jdkElement->setAttribute("iterations"=>1);
142	    $jdkElement->setAttribute("time" => $testResult);
143	    $root->appendChild($jdkElement);
144
145            # measure baseline method
146            my $b = measure2($testclass, $baselineMethod, $pat, -$DURATION);
147            my $baseResult = $b->getMean();
148	    my $icuElement = $doc->createElement("perfTestResult");
149	    my $testName = "NumFmt-$testname-$patternName";
150	    $icuElement->setAttribute("test"=> $testName);
151	    $icuElement->setAttribute("iterations"=>1);
152	    $icuElement->setAttribute("time" => $baseResult);
153	    $root->appendChild($icuElement);
154	}
155    }
156
157#----------------COLLATION PERFORMANCE TESTS--------------------------_
158
159    %dataFiles = (
160   	   "en_US",         "TestNames_Latin.txt",
161	   "da_DK",         "TestNames_Latin.txt",
162	   "de_DE",         "TestNames_Latin.txt",
163	   "de__PHONEBOOK", "TestNames_Latin.txt",
164	   "fr_FR",         "TestNames_Latin.txt",
165	   "ja_JP",         "TestNames_Latin.txt TestNames_Japanese_h.txt TestNames_Japanese_k.txt TestNames_Asian.txt",
166	   "zh_CN",         "TestNames_Latin.txt TestNames_Chinese.txt",
167	   "zh_TW",         "TestNames_Latin.txt TestNames_Chinese.txt",
168	   "zh__PINYIN",    "TestNames_Latin.txt TestNames_Chinese.txt",
169	   "ru_RU", 	    "TestNames_Latin.txt TestNames_Russian.txt",
170	   "th",            "TestNames_Latin.txt TestNames_Thai.txt",
171	   "ko_KR",         "TestNames_Latin.txt TestNames_Korean.txt",
172	   );
173
174    #  Outer loop runs through the locales to test
175    #     (Edit this list dirctly to make changes)
176    #
177    foreach  $locale (
178	   "en_US",
179	   "da_DK",
180	   "de_DE",
181	   "de__PHONEBOOK",
182	   "fr_FR",
183	   "ja_JP",
184           "zh_CN",
185	   "zh_TW",
186	   "zh__PINYIN",
187           "ko_KR",
188	   "ru_RU",
189	   "th",
190                   )
191       {
192
193
194       #
195       # Inner loop runs over the set of data files specified for each locale.
196       #    (Edit the %datafiles initialization, above, to make changes.
197       #
198        $ff = $dataFiles{$locale};
199        @ff = split(/[\s]+/, $ff);
200        $counter = 1;
201        foreach  $data (@ff) {
202          #
203          # Run ICU Test for this (locale, data file) pair.
204          #
205           $iStrCol = `java -classpath $CLASSPATH com.ibm.icu.dev.test.perf.CollationPerformanceTest -terse -file data/collation/$data -locale $locale -loop 1000 -binsearch`;
206print "java -classpath $CLASSPATH com.ibm.icu.dev.test.perf.CollationPerformanceTest -terse -file data/collation/$data -locale $locale -loop 1000 -binsearch\n";
207  $iStrCol =~s/[,\s]*//g;  # whack off the leading "  ," in the returned result.
208          doKeyTimes("java -classpath $CLASSPATH com.ibm.icu.dev.test.perf.CollationPerformanceTest -terse -file data/collation/$data -locale $locale -loop 1000 -keygen",
209                    my $iKeyGen, my $iKeyLen);
210
211          #
212          # Run Windows test for this (locale, data file) pair.  Only do if
213          #    we are not on Windows 98/ME and we hava a windows langID
214          #    for the locale.
215          #
216           $wStrCol =  $wKeyGen =  $wKeyLen = 0;
217          my $wStrCol = `java -classpath $CLASSPATH com.ibm.icu.dev.test.perf.CollationPerformanceTest -terse -file data/collation/$data -locale $locale -loop 1000 -binsearch -java`;
218          $wStrCol =~s/[,\s]*//g;  # whack off the leading "  ," in the returned result.
219          doKeyTimes("java -classpath $CLASSPATH com.ibm.icu.dev.test.perf.CollationPerformanceTest -terse -file data/collation/$data -locale $locale -loop 1000 -keygen -java",
220                     $wKeyGen, $wKeyLen);
221
222           $collDiff =  $keyGenDiff =  $keyLenDiff = 0;
223          if ($wKeyLen > 0) {
224               $collDiff   = (($wStrCol - $iStrCol) / $iStrCol) * 100;
225               $keyGenDiff = (($wKeyGen - $iKeyGen) / $iKeyGen) * 100;
226               $keyLenDiff = (($wKeyLen - $iKeyLen) / $iKeyLen) * 100;
227          }
228
229	my $ICU = $doc->createElement("perfTestResult");
230	my $testname = "Coll-$locale-data$counter-StrCol";
231	#write the results corresponding to this local,data pair
232	$ICU->setAttribute("test"=> $testname);
233	$ICU->setAttribute("iterations"=>1000);
234	$ICU->setAttribute("time"=> $iStrCol);
235	$root->appendChild($ICU);
236
237	my $Key = $doc->createElement("perfTestResult");
238	my $testname = "Coll-$locale-data$counter-keyGen";
239	$Key->setAttribute("test"=> $testname);
240	$Key->setAttribute("iterations"=>1000);
241	$Key->setAttribute("time"=>$iKeyGen);
242	$root->appendChild($Key);
243
244	my $JDK = $doc->createElement("perfTestResult");
245	my $testname = "Coll-$locale-data$counter-StrCol-JDK";
246	$JDK->setAttribute("test"=>$testname);
247	$JDK->setAttribute("iterations"=>1000);
248	$JDK->setAttribute("time"=>$wStrCol);
249	$root->appendChild($JDK);
250
251	my $Key = $doc->createElement("perfTestResult");
252	my $testname = "Coll-$locale-data$counter-keyGen-JDK";
253	$Key->setAttribute("test"=>$testname);
254	$Key->setAttribute("iterations"=>1000);
255	$Key->setAttribute("time"=>$wKeyGen);
256	$root->appendChild($Key);
257	$counter++;
258     }
259   }
260
261
262
263#----------WRITE RESULTS TO perf.xml-----------------------
264    $doc->setDocumentElement($root);
265    open my $out_fh, '>', "perf.xml";
266    print {$out_fh} $doc->toString;
267}
268
269
270#---------------------------------------------------------------------
271# Append text to the global variable $OUT
272sub out {
273   $OUT .= join('', @_);
274}
275
276
277#---------------------------------------------------------------------
278# Measure a given test method with a give test pattern using the
279# global run parameters.
280#
281# @param the method to run
282# @param the pattern defining characters to test
283# @param if >0 then the number of iterations per pass.  If <0 then
284#        (negative of) the number of seconds per pass.
285#
286# @return a Dataset object, scaled by iterations per pass and
287#         events per iteration, to give time per event
288#
289sub measure2 {
290    my @data = measure1(@_);
291    my $iterPerPass = shift(@data);
292    my $eventPerIter = shift(@data);
293
294    shift(@data) if (@data > 1); # discard first run
295
296    my $ds = Dataset->new(@data);
297    $ds->setScale(1.0e-3 / ($iterPerPass * $eventPerIter));
298    $ds;
299}
300
301#---------------------------------------------------------------------
302# Measure a given test method with a give test pattern using the
303# global run parameters.
304#
305# @param the method to run
306# @param the pattern defining characters to test
307# @param if >0 then the number of iterations per pass.  If <0 then
308#        (negative of) the number of seconds per pass.
309#
310# @return array of:
311#         [0] iterations per pass
312#         [1] events per iteration
313#         [2..] ms reported for each pass, in order
314#
315sub measure1 {
316    my $testclass = shift;
317    my $method = shift;
318    my $pat = shift;
319    my $iterCount = shift; # actually might be -seconds/pass
320
321    # is $iterCount actually -seconds/pass?
322    if ($iterCount < 0) {
323
324        # calibrate: estimate ms/iteration
325        print "Calibrating...";
326        my @t = callJava($testclass, $method, $pat, -$CALIBRATE, 1);
327        print "done.\n";
328
329        my @data = split(/\s+/, $t[0]->[2]);
330        $data[0] *= 1.0e+3;
331
332        my $timePerIter = 1.0e-3 * $data[0] / $data[1];
333
334        # determine iterations/pass
335        $iterCount = int(-$iterCount / $timePerIter + 0.5);
336   }
337
338    # run passes
339    print "Measuring $iterCount iterations x $NUMPASSES passes...";
340    my @t = callJava($testclass, $method, $pat, $iterCount, $NUMPASSES);
341    print "done.\n";
342    my @ms = ();
343    my @b; # scratch
344    for my $a (@t) {
345        # $a->[0]: method name, corresponds to $method
346        # $a->[1]: 'begin' data, == $iterCount
347        # $a->[2]: 'end' data, of the form <ms> <loops> <eventsPerIter>
348        # $a->[3...]: gc messages from JVM during pass
349        @b = split(/\s+/, $a->[2]);
350        push(@ms, $b[0] * 1.0e+3);
351    }
352    my $eventsPerIter = $b[2];
353
354    my @ms_str = @ms;
355    $ms_str[0] .= " (discarded)" if (@ms_str > 1);
356
357    ($iterCount, $eventsPerIter, @ms);
358}
359
360#---------------------------------------------------------------------
361# Invoke java to run $TESTCLASS, passing it the given parameters.
362#
363# @param the method to run
364# @param the number of iterations, or if negative, the duration
365#        in seconds.  If more than on pass is desired, pass in
366#        a string, e.g., "100 100 100".
367# @param the pattern defining characters to test
368#
369# @return an array of results.  Each result is an array REF
370#         describing one pass.  The array REF contains:
371#         ->[0]: The method name as reported
372#         ->[1]: The params on the '= <meth> begin ...' line
373#         ->[2]: The params on the '= <meth> end ...' line
374#         ->[3..]: GC messages from the JVM, if any
375#
376sub callJava {
377    my $testclass = shift;
378    my $method = shift;
379    my $pat = shift;
380    my $n = shift;
381    my $passes = shift;
382
383    my $n = ($n < 0) ? "-t ".(-$n) : "-i ".$n;
384
385    my $cmd = "java -classpath $CLASSPATH $testclass $method $n -p $passes -L @$pat[0] \"@$pat[1]\" \"@$pat[2]\" -r $THREADS";
386    print "[$cmd]\n"; # for debugging
387    open(PIPE, "$cmd|") or die "Can't run \"$cmd\"";
388    my @out;
389    while (<PIPE>) {
390        push(@out, $_);
391    }
392    close(PIPE) or die "Java failed: \"$cmd\"";
393
394    @out = grep(!/^\#/, @out);  # filter out comments
395
396    #print "[", join("\n", @out), "]\n";
397
398    my @results;
399    my $method = '';
400    my $data = [];
401    foreach (@out) {
402        next unless (/\S/);
403
404        if (/^=\s*(\w+)\s*(\w+)\s*(.*)/) {
405            my ($m, $state, $d) = ($1, $2, $3);
406            #print "$_ => [[$m $state $data]]\n";
407            if ($state eq 'begin') {
408                die "$method was begun but not finished" if ($method);
409                $method = $m;
410                push(@$data, $d);
411                push(@$data, ''); # placeholder for end data
412            } elsif ($state eq 'end') {
413                if ($m ne $method) {
414                    die "$method end does not match: $_";
415                }
416                $data->[1] = $d; # insert end data at [1]
417                #print "#$method:", join(";",@$data), "\n";
418                unshift(@$data, $method); # add method to start
419
420                push(@results, $data);
421                $method = '';
422                $data = [];
423            } else {
424                die "Can't parse: $_";
425           }
426        }
427       elsif (/^\[/) {
428            if ($method) {
429                push(@$data, $_);
430            } else {
431                # ignore extraneous GC notices
432            }
433        }
434        else {
435            die "Can't parse: $_";
436        }
437    }
438
439    die "$method was begun but not finished" if ($method);
440
441    @results;
442}
443
444#-----------------------------------------------------------------------------------
445#  doKeyGenTimes($Command_to_run, $time, $key_length)
446#       Do a key-generation test and return the time and key length/char values.
447#
448sub doKeyTimes($$$) {
449   # print "$_[0]\n";
450   local($x) = `$_[0]`;                  # execute the collperf command.
451   ($_[1], $_[2]) = split(/\,/, $x);     # collperf returns "time, keylength" string.
452}
453
454
455#eof
456