1 #!/usr/local/bin/perl 2 # *********************************************************************** 3 # * COPYRIGHT: 4 # * Copyright (c) 2002-2008, 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 @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 141 shift(@data) if (@data > 1); # discard first run 142 143 #debug("data is @data\n"); 144 my $ds = Dataset->new(@data); 145 146 push(@timedata, $ds); 147 } 148 149 outputRow($i, \@iterPerPass, \@noopers, \@timedata, \@noevents); 150 } 151 152 } 153 154 #--------------------------------------------------------------------- 155 # Measure a given test method with a give test pattern using the 156 # global run parameters. 157 # 158 # @param the method to run 159 # @param the pattern defining characters to test 160 # @param if >0 then the number of iterations per pass. If <0 then 161 # (negative of) the number of seconds per pass. 162 # 163 # @return array of: 164 # [0] iterations per pass 165 # [1] events per iteration 166 # [2..] ms reported for each pass, in order 167 # 168 sub measure1 { 169 # run passes 170 my @t = callProg(shift); #"$program $args $argsAndTest"); 171 my @ms = (); 172 my @b; # scratch 173 for my $a (@t) { 174 # $a->[0]: method name, corresponds to $method 175 # $a->[1]: 'begin' data, == $iterCount 176 # $a->[2]: 'end' data, of the form <ms> <eventsPerIter> 177 # $a->[3...]: gc messages from JVM during pass 178 @b = split(/\s+/, $a->[2]); 179 #push(@ms, $b[0]); 180 push(@ms, shift(@b)); 181 } 182 my $iterCount = shift(@b); 183 my $operationsPerIter = shift(@b); 184 my $eventsPerIter; 185 if($#b >= 0) { 186 $eventsPerIter = shift(@b); 187 } 188 189 # out("Iterations per pass: $iterCount<BR>\n"); 190 # out("Events per iteration: $eventsPerIter<BR>\n"); 191 # debug("Iterations per pass: $iterCount<BR>\n"); 192 # if($eventsPerIter) { 193 # debug("Events per iteration: $eventsPerIter<BR>\n"); 194 # } 195 196 my @ms_str = @ms; 197 $ms_str[0] .= " (discarded)" if (@ms_str > 1); 198 # out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n"); 199 debug("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n"); 200 if($eventsPerIter) { 201 ($iterCount, $operationsPerIter, \@ms, $eventsPerIter); 202 } else { 203 ($iterCount, $operationsPerIter, \@ms); 204 } 205 } 206 207 208 209 #--------------------------------------------------------------------- 210 # Measure a given test method with a give test pattern using the 211 # global run parameters. 212 # 213 # @param the method to run 214 # @param the pattern defining characters to test 215 # @param if >0 then the number of iterations per pass. If <0 then 216 # (negative of) the number of seconds per pass. 217 # 218 # @return a Dataset object, scaled by iterations per pass and 219 # events per iteration, to give time per event 220 # 221 sub measure2 { 222 my @res = measure1(@_); 223 my $iterPerPass = shift(@res); 224 my $operationsPerIter = shift(@res); 225 my @data = @{ shift(@res) }; 226 my $eventsPerIter = shift(@res); 227 228 229 shift(@data) if (@data > 1); # discard first run 230 231 my $ds = Dataset->new(@data); 232 #$ds->setScale(1.0e-3 / ($iterPerPass * $operationsPerIter)); 233 ($ds, $iterPerPass, $operationsPerIter, $eventsPerIter); 234 } 235 236 237 #--------------------------------------------------------------------- 238 # Invoke program and capture results, passing it the given parameters. 239 # 240 # @param the method to run 241 # @param the number of iterations, or if negative, the duration 242 # in seconds. If more than on pass is desired, pass in 243 # a string, e.g., "100 100 100". 244 # @param the pattern defining characters to test 245 # 246 # @return an array of results. Each result is an array REF 247 # describing one pass. The array REF contains: 248 # ->[0]: The method name as reported 249 # ->[1]: The params on the '= <meth> begin ...' line 250 # ->[2]: The params on the '= <meth> end ...' line 251 # ->[3..]: GC messages from the JVM, if any 252 # 253 sub callProg { 254 my $cmd = shift; 255 #my $pat = shift; 256 #my $n = shift; 257 258 #my $cmd = "java -cp c:\\dev\\myicu4j\\classes $TESTCLASS $method $n $pat"; 259 debug( "[$cmd]\n"); # for debugging 260 open(PIPE, "$cmd|") or die "Can't run \"$cmd\""; 261 my @out; 262 while (<PIPE>) { 263 push(@out, $_); 264 } 265 close(PIPE) or die "Program failed: \"$cmd\""; 266 267 @out = grep(!/^\#/, @out); # filter out comments 268 269 #debug( "[", join("\n", @out), "]\n"); 270 271 my @results; 272 my $method = ''; 273 my $data = []; 274 foreach (@out) { 275 next unless (/\S/); 276 277 if (/^=\s*(\w+)\s*(\w+)\s*(.*)/) { 278 my ($m, $state, $d) = ($1, $2, $3); 279 #debug ("$_ => [[$m $state !!!$d!!! $data ]]\n"); 280 if ($state eq 'begin') { 281 die "$method was begun but not finished" if ($method); 282 $method = $m; 283 push(@$data, $d); 284 push(@$data, ''); # placeholder for end data 285 } elsif ($state eq 'end') { 286 if ($m ne $method) { 287 die "$method end does not match: $_"; 288 } 289 $data->[1] = $d; # insert end data at [1] 290 #debug( "#$method:", join(";",@$data), "\n"); 291 unshift(@$data, $method); # add method to start 292 push(@results, $data); 293 $method = ''; 294 $data = []; 295 } else { 296 die "Can't parse: $_"; 297 } 298 } 299 300 elsif (/^\[/) { 301 if ($method) { 302 push(@$data, $_); 303 } else { 304 # ignore extraneous GC notices 305 } 306 } 307 308 else { 309 # die "Can't parse: $_"; 310 } 311 } 312 313 die "$method was begun but not finished" if ($method); 314 315 @results; 316 } 317 318 sub debug { 319 my $message; 320 if($DEBUG != 0) { 321 foreach $message (@_) { 322 print STDERR "$message"; 323 } 324 } 325 } 326 327 sub measure1Alan { 328 #Added here, was global 329 my $CALIBRATE = 2; # duration in seconds for initial calibration 330 331 my $method = shift; 332 my $pat = shift; 333 my $iterCount = shift; # actually might be -seconds/pass 334 335 out("<P>Measuring $method using $pat, "); 336 if ($iterCount > 0) { 337 out("$iterCount iterations/pass, $NUMPASSES passes</P>\n"); 338 } else { 339 out(-$iterCount, " seconds/pass, $NUMPASSES passes</P>\n"); 340 } 341 342 # is $iterCount actually -seconds? 343 if ($iterCount < 0) { 344 345 # calibrate: estimate ms/iteration 346 print "Calibrating..."; 347 my @t = callJava($method, $pat, -$CALIBRATE); 348 print "done.\n"; 349 350 my @data = split(/\s+/, $t[0]->[2]); 351 my $timePerIter = 1.0e-3 * $data[0] / $data[2]; 352 353 # determine iterations/pass 354 $iterCount = int(-$iterCount / $timePerIter + 0.5); 355 356 out("<P>Calibration pass ($CALIBRATE sec): "); 357 out("$data[0] ms, "); 358 out("$data[2] iterations = "); 359 out(formatSeconds(4, $timePerIter), "/iteration<BR>\n"); 360 } 361 362 # run passes 363 print "Measuring $iterCount iterations x $NUMPASSES passes..."; 364 my @t = callJava($method, $pat, "$iterCount " x $NUMPASSES); 365 print "done.\n"; 366 my @ms = (); 367 my @b; # scratch 368 for my $a (@t) { 369 # $a->[0]: method name, corresponds to $method 370 # $a->[1]: 'begin' data, == $iterCount 371 # $a->[2]: 'end' data, of the form <ms> <eventsPerIter> 372 # $a->[3...]: gc messages from JVM during pass 373 @b = split(/\s+/, $a->[2]); 374 push(@ms, $b[0]); 375 } 376 my $eventsPerIter = $b[1]; 377 378 out("Iterations per pass: $iterCount<BR>\n"); 379 out("Events per iteration: $eventsPerIter<BR>\n"); 380 381 my @ms_str = @ms; 382 $ms_str[0] .= " (discarded)" if (@ms_str > 1); 383 out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n"); 384 385 ($iterCount, $eventsPerIter, @ms); 386 } 387 388 389 1; 390 391 #eof 392