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