| OLD | NEW |
|---|
| (Empty) |
| 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 | |
| 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; | |
| 26 my $ITERATIONS; #Added by Doug | |
| 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 } | |
| 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 | |
| 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} }) { | |
| 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 | |
| 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) { | |
| 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 @argsA
ndTest"; | |
| 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 # | |
| 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 { | |
| 308 # die "Can't parse: $_"; | |
| 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 | |
| OLD | NEW |
|---|
Chromium Code Reviews
Issue 2435373002:
Delete source/test (Closed)
