]>
Commit | Line | Data |
---|---|---|
b75a7d8f | 1 | #!/usr/local/bin/perl |
374ca955 | 2 | # *********************************************************************** |
b75a7d8f | 3 | # * COPYRIGHT: |
57a6839d | 4 | # * Copyright (c) 2002-2013, International Business Machines Corporation |
374ca955 A |
5 | # * and others. All Rights Reserved. |
6 | # *********************************************************************** | |
b75a7d8f A |
7 | |
8 | use strict; | |
9 | ||
10 | #use Dataset; | |
11 | use Format; | |
12 | use Output; | |
13 | ||
14 | my $VERBOSE = 0; | |
15 | my $DEBUG = 1; | |
16 | my $start_l = ""; #formatting help | |
17 | my $end_l = ""; | |
18 | my @testArgs; # different kinds of tests we want to do | |
19 | my $datadir = "data"; | |
20 | my $extraArgs; # stuff that always gets passed to the test program | |
21 | ||
22 | ||
23 | my $iterCount = 0; | |
24 | my $NUMPASSES = 4; | |
25 | my $TIME = 2; | |
374ca955 | 26 | my $ITERATIONS; #Added by Doug |
b75a7d8f A |
27 | my $DATADIR; |
28 | ||
29 | sub 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 | } | |
57a6839d | 39 | |
b75a7d8f A |
40 | if($options{"dataDir"}) { |
41 | $DATADIR = $options{"dataDir"}; | |
42 | } | |
374ca955 A |
43 | |
44 | # Added by Doug | |
45 | if ($options{"iterations"}) { | |
57a6839d | 46 | $ITERATIONS = $options{"iterations"}; |
374ca955 | 47 | } |
b75a7d8f A |
48 | } |
49 | ||
50 | sub 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} }) { | |
57a6839d A |
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 | } | |
b75a7d8f A |
84 | } |
85 | } | |
86 | } else { | |
87 | compareLoop($tests); | |
88 | } | |
89 | closeOutput(); | |
90 | } | |
91 | ||
92 | sub 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) { | |
57a6839d | 100 | $locAndData .= " -L \"$locale\""; |
b75a7d8f A |
101 | } |
102 | if($datafile) { | |
103 | $locAndData .= " -f $datafile"; | |
104 | } | |
57a6839d | 105 | |
b75a7d8f A |
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 | |
57a6839d | 121 | ($program, @argsAndTest) = split(/,/, @{ $tests{$i} }[$j]); |
374ca955 A |
122 | #Modified by Doug |
123 | my $commandLine; | |
124 | if ($ITERATIONS) { | |
57a6839d | 125 | $commandLine = "$program -i $ITERATIONS -p $NUMPASSES $locAndData @argsAndTest"; |
374ca955 | 126 | } else { |
57a6839d A |
127 | $commandLine = "$program -t $TIME -p $NUMPASSES $locAndData @argsAndTest"; |
128 | } | |
b75a7d8f A |
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) { | |
57a6839d A |
137 | push(@noevents, shift(@res)); |
138 | } | |
b75a7d8f A |
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 | # | |
167 | sub 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 | # | |
220 | sub 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 | # | |
252 | sub 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 { | |
46f4442e | 308 | # die "Can't parse: $_"; |
b75a7d8f A |
309 | } |
310 | } | |
311 | ||
312 | die "$method was begun but not finished" if ($method); | |
313 | ||
314 | @results; | |
315 | } | |
316 | ||
317 | sub debug { | |
318 | my $message; | |
319 | if($DEBUG != 0) { | |
320 | foreach $message (@_) { | |
321 | print STDERR "$message"; | |
322 | } | |
323 | } | |
324 | } | |
325 | ||
326 | sub 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 | ||
388 | 1; | |
389 | ||
390 | #eof |