1#!/usr/local/bin/perl
2#  ***********************************************************************
3#  * COPYRIGHT:
4#  * © 2016 and later: Unicode, Inc. and others.
5#  * License & terms of use: http://www.unicode.org/copyright.html#License
6#  * Copyright (c) 2002-2006, International Business Machines Corporation
7#  * and others. All Rights Reserved.
8#  ***********************************************************************
9
10use strict;
11
12#use Dataset;
13use Format;
14use Output;
15
16my $VERBOSE = 0;
17my $DEBUG   = 1;
18my $start_l = ""; #formatting help
19my $end_l   = "";
20my @testArgs; # different kinds of tests we want to do
21my $datadir = "data";
22my $extraArgs; # stuff that always gets passed to the test program
23
24
25my $iterCount = 0;
26my $NUMPASSES = 4;
27my $TIME = 2;
28my $ITERATIONS;   #Added by Doug
29my $DATADIR;
30
31sub setupOptions {
32  my %options = %{shift @_};
33
34  if($options{"time"}) {
35    $TIME = $options{"time"};
36  }
37
38  if($options{"passes"}) {
39    $NUMPASSES = $options{"passes"};
40  }
41
42  if($options{"dataDir"}) {
43    $DATADIR = $options{"dataDir"};
44  }
45
46  # Added by Doug
47  if ($options{"iterations"}) {
48  	$ITERATIONS = $options{"iterations"};
49  }
50}
51
52sub runTests {
53  debug("Enter runTest in PerfFramework4j\n");
54  my $options = shift;
55  my @programs;
56  my $tests = shift;
57  my %datafiles;
58  if($#_ >= 0) { # maybe no files/locales
59    my $datafiles = shift;
60    if($datafiles) {
61      %datafiles = %{$datafiles};
62    }
63  }
64  setupOutput($options);
65  setupOptions($options);
66
67  my($locale, $iter, $data, $program, $args, $variable);
68#
69#  Outer loop runs through the locales to test
70#
71  if (%datafiles) {
72    foreach $locale (sort keys %datafiles ) {
73      foreach $data (@{ $datafiles{$locale} }) {
74	closeTable;
75	my $locdata = "";
76	if(!($locale eq "")) {
77	  $locdata = "<b>Locale:</b> $locale<br>";
78	}
79	$locdata .= "<b>Datafile:</b> $data<br>";
80	startTest($locdata);
81
82	if($DATADIR) {
83	  compareLoop ($tests, $locale, $DATADIR."/".$data);
84	} else {
85	  compareLoop ($tests, $locale, $data);
86	}
87      }
88    }
89  } else {
90    compareLoop($tests);
91  }
92  closeOutput();
93}
94
95sub compareLoop {
96  #debug("enter compareLoop\n");
97
98  my $tests = shift;
99  #debug("tests $tests");
100  #my @tests = @{$tests};
101  my %tests = %{$tests};
102  #debug("tests $tests");
103  my $locale = shift;
104  my $datafile = shift;
105  my $locAndData = "";
106  if($locale) {
107    $locAndData .= " -L $locale";
108  }
109
110  if($datafile) {
111    $locAndData .= " -f $datafile";
112  }
113
114  my $args;
115  my ($i, $j, $aref);
116  foreach $i ( sort keys %tests ) {
117    #debug("Test: $i\n");
118    $aref = $tests{$i};
119    my @timedata;
120    my @iterPerPass;
121    my @noopers;
122    my @noevents;
123
124    my $program;
125    my @argsAndTest;
126    for $j ( 0 .. $#{$aref} ) {
127    # first we calibrate. Use time from somewhere
128    # first test is used for calibration
129    ##################
130    #  ($program, @argsAndTest) = split(/\ /, @{ $tests{$i} }[$j]);
131    #  #Modified by Doug
132    #   my $commandLine;
133    #  if ($ITERATIONS) {
134    #  	$commandLine = "$program -i $ITERATIONS -p $NUMPASSES $locAndData @argsAndTest";
135    #  } else {
136    #  	$commandLine = "$program -t $TIME -p $NUMPASSES $locAndData @argsAndTest";
137    # 	}
138    ######################
139    ######################
140    my $custArgs;
141    my $testCommand = @{ $tests{$i} }[$j];
142      if ($testCommand =~/--/) {
143      	$custArgs = $& . $';	#The matched part and the right part
144      	$testCommand = $`;		#The left part for furthur processing
145      } else { $custArgs = ''; }
146      ($program, @argsAndTest) = split(/\ /, $testCommand);
147      my $commandLine;
148      if ($ITERATIONS) {
149      	$commandLine = "$program @argsAndTest -i $ITERATIONS -p $NUMPASSES $locAndData $custArgs";
150      } else {
151      	$commandLine = "$program @argsAndTest -t $TIME -p $NUMPASSES $locAndData $custArgs";
152    	}
153    #debug("custArgs:$custArgs\n");
154    ####################
155
156      my @res = measure1($commandLine);
157      store("$i, $program @argsAndTest", @res);
158
159      push(@iterPerPass, shift(@res));
160      push(@noopers, shift(@res));
161      my @data = @{ shift(@res) };
162      if($#res >= 0) {
163	push(@noevents, shift(@res));
164      }
165
166
167      shift(@data) if (@data > 1); # discard first run
168
169      #debug("data is @data\n");
170      my $ds = Dataset->new(@data);
171
172      push(@timedata, $ds);
173    }
174
175    outputRow($i, \@iterPerPass, \@noopers, \@timedata, \@noevents);
176  }
177
178}
179
180#---------------------------------------------------------------------
181# Measure a given test method with a give test pattern using the
182# global run parameters.
183#
184# @param the method to run
185# @param the pattern defining characters to test
186# @param if >0 then the number of iterations per pass.  If <0 then
187#        (negative of) the number of seconds per pass.
188#
189# @return array of:
190#         [0] iterations per pass
191#         [1] events per iteration
192#         [2..] ms reported for each pass, in order
193#
194sub measure1 {
195    # run passes
196    my @t = callProg(shift); #"$program $args $argsAndTest");
197    my @ms = ();
198    my @b; # scratch
199    for my $a (@t) {
200        # $a->[0]: method name, corresponds to $method
201        # $a->[1]: 'begin' data, == $iterCount
202        # $a->[2]: 'end' data, of the form <ms> <eventsPerIter>
203        # $a->[3...]: gc messages from JVM during pass
204        @b = split(/\s+/, $a->[2]);
205        #push(@ms, $b[0]);
206        push(@ms, shift(@b));
207    }
208    my $iterCount = shift(@b);
209    my $operationsPerIter = shift(@b);
210    my $eventsPerIter;
211    if($#b >= 0) {
212      $eventsPerIter = shift(@b);
213    }
214
215#    out("Iterations per pass: $iterCount<BR>\n");
216#    out("Events per iteration: $eventsPerIter<BR>\n");
217#    debug("Iterations per pass: $iterCount<BR>\n");
218#    if($eventsPerIter) {
219#      debug("Events per iteration: $eventsPerIter<BR>\n");
220#    }
221
222    my @ms_str = @ms;
223    $ms_str[0] .= " (discarded)" if (@ms_str > 1);
224#    out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
225    debug("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
226    if($eventsPerIter) {
227      ($iterCount, $operationsPerIter, \@ms, $eventsPerIter);
228    } else {
229      ($iterCount, $operationsPerIter, \@ms);
230    }
231}
232
233
234
235#---------------------------------------------------------------------
236# Measure a given test method with a give test pattern using the
237# global run parameters.
238#
239# @param the method to run
240# @param the pattern defining characters to test
241# @param if >0 then the number of iterations per pass.  If <0 then
242#        (negative of) the number of seconds per pass.
243#
244# @return a Dataset object, scaled by iterations per pass and
245#         events per iteration, to give time per event
246#
247sub measure2 {
248    my @res = measure1(@_);
249    my $iterPerPass = shift(@res);
250    my $operationsPerIter = shift(@res);
251    my @data = @{ shift(@res) };
252    my $eventsPerIter = shift(@res);
253
254
255    shift(@data) if (@data > 1); # discard first run
256
257    my $ds = Dataset->new(@data);
258    #$ds->setScale(1.0e-3 / ($iterPerPass * $operationsPerIter));
259    ($ds, $iterPerPass, $operationsPerIter, $eventsPerIter);
260}
261
262
263#---------------------------------------------------------------------
264# Invoke program and capture results, passing it the given parameters.
265#
266# @param the method to run
267# @param the number of iterations, or if negative, the duration
268#        in seconds.  If more than on pass is desired, pass in
269#        a string, e.g., "100 100 100".
270# @param the pattern defining characters to test
271#
272# @return an array of results.  Each result is an array REF
273#         describing one pass.  The array REF contains:
274#         ->[0]: The method name as reported
275#         ->[1]: The params on the '= <meth> begin ...' line
276#         ->[2]: The params on the '= <meth> end ...' line
277#         ->[3..]: GC messages from the JVM, if any
278#
279sub callProg {
280    my $cmd = shift;
281    #my $pat = shift;
282    #my $n = shift;
283
284    #my $cmd = "java -cp c:\\dev\\myicu4j\\classes $TESTCLASS $method $n $pat";
285    debug( "[$cmd]\n"); # for debugging
286    open(PIPE, "$cmd|") or die "Can't run \"$cmd\"";
287    my @out;
288    while (<PIPE>) {
289        push(@out, $_);
290    }
291    close(PIPE) or die "Program failed: \"$cmd\"";
292
293    @out = grep(!/^\#/, @out);  # filter out comments
294
295    #debug( "[", join("\n", @out), "]\n");
296
297    my @results;
298    my $method = '';
299    my $data = [];
300    foreach (@out) {
301        next unless (/\S/);
302
303        if (/^=\s*(\w+)\s*(\w+)\s*(.*)/) {
304            my ($m, $state, $d) = ($1, $2, $3);
305            #debug ("$_ => [[$m $state !!!$d!!! $data ]]\n");
306            if ($state eq 'begin') {
307                die "$method was begun but not finished" if ($method);
308                $method = $m;
309                push(@$data, $d);
310                push(@$data, ''); # placeholder for end data
311            } elsif ($state eq 'end') {
312                if ($m ne $method) {
313                    die "$method end does not match: $_";
314                }
315                $data->[1] = $d; # insert end data at [1]
316                #debug( "#$method:", join(";",@$data), "\n");
317                unshift(@$data, $method); # add method to start
318                push(@results, $data);
319                $method = '';
320                $data = [];
321            } else {
322                die "Can't parse: $_";
323            }
324        }
325
326        elsif (/^\[/) {
327            if ($method) {
328                push(@$data, $_);
329            } else {
330                # ignore extraneous GC notices
331            }
332        }
333
334        else {
335            die "Can't parse: $_";
336        }
337    }
338
339    die "$method was begun but not finished" if ($method);
340
341    @results;
342}
343
344sub debug  {
345  my $message;
346  if($DEBUG != 0) {
347    foreach $message (@_) {
348      print STDERR "$message";
349    }
350  }
351}
352
353sub measure1Alan {
354  #Added here, was global
355  my $CALIBRATE = 2; # duration in seconds for initial calibration
356
357    my $method = shift;
358    my $pat = shift;
359    my $iterCount = shift; # actually might be -seconds/pass
360
361    out("<P>Measuring $method using $pat, ");
362    if ($iterCount > 0) {
363        out("$iterCount iterations/pass, $NUMPASSES passes</P>\n");
364    } else {
365        out(-$iterCount, " seconds/pass, $NUMPASSES passes</P>\n");
366    }
367
368    # is $iterCount actually -seconds?
369    if ($iterCount < 0) {
370
371        # calibrate: estimate ms/iteration
372        print "Calibrating...";
373        my @t = callJava($method, $pat, -$CALIBRATE);
374        print "done.\n";
375
376        my @data = split(/\s+/, $t[0]->[2]);
377        my $timePerIter = 1.0e-3 * $data[0] / $data[2];
378
379        # determine iterations/pass
380        $iterCount = int(-$iterCount / $timePerIter + 0.5);
381
382        out("<P>Calibration pass ($CALIBRATE sec): ");
383        out("$data[0] ms, ");
384        out("$data[2] iterations = ");
385        out(formatSeconds(4, $timePerIter), "/iteration<BR>\n");
386    }
387
388    # run passes
389    print "Measuring $iterCount iterations x $NUMPASSES passes...";
390    my @t = callJava($method, $pat, "$iterCount " x $NUMPASSES);
391    print "done.\n";
392    my @ms = ();
393    my @b; # scratch
394    for my $a (@t) {
395        # $a->[0]: method name, corresponds to $method
396        # $a->[1]: 'begin' data, == $iterCount
397        # $a->[2]: 'end' data, of the form <ms> <eventsPerIter>
398        # $a->[3...]: gc messages from JVM during pass
399        @b = split(/\s+/, $a->[2]);
400        push(@ms, $b[0]);
401    }
402    my $eventsPerIter = $b[1];
403
404    out("Iterations per pass: $iterCount<BR>\n");
405    out("Events per iteration: $eventsPerIter<BR>\n");
406
407    my @ms_str = @ms;
408    $ms_str[0] .= " (discarded)" if (@ms_str > 1);
409    out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
410
411    ($iterCount, $eventsPerIter, @ms);
412}
413
414
4151;
416
417#eof
418