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