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