| #!/usr/local/bin/perl |
| # *********************************************************************** |
| # * COPYRIGHT: |
| # * © 2016 and later: Unicode, Inc. and others. |
| # * License & terms of use: http://www.unicode.org/copyright.html |
| # * Copyright (c) 2002-2006, International Business Machines Corporation |
| # * and others. All Rights Reserved. |
| # *********************************************************************** |
| |
| use strict; |
| |
| #use Dataset; |
| use Format; |
| use Output; |
| |
| my $VERBOSE = 0; |
| my $DEBUG = 1; |
| my $start_l = ""; #formatting help |
| my $end_l = ""; |
| my @testArgs; # different kinds of tests we want to do |
| my $datadir = "data"; |
| my $extraArgs; # stuff that always gets passed to the test program |
| |
| |
| my $iterCount = 0; |
| my $NUMPASSES = 4; |
| my $TIME = 2; |
| my $ITERATIONS; #Added by Doug |
| my $DATADIR; |
| |
| sub setupOptions { |
| my %options = %{shift @_}; |
| |
| if($options{"time"}) { |
| $TIME = $options{"time"}; |
| } |
| |
| if($options{"passes"}) { |
| $NUMPASSES = $options{"passes"}; |
| } |
| |
| if($options{"dataDir"}) { |
| $DATADIR = $options{"dataDir"}; |
| } |
| |
| # Added by Doug |
| if ($options{"iterations"}) { |
| $ITERATIONS = $options{"iterations"}; |
| } |
| } |
| |
| sub runTests { |
| debug("Enter runTest in PerfFramework4j\n"); |
| my $options = shift; |
| my @programs; |
| my $tests = shift; |
| my %datafiles; |
| if($#_ >= 0) { # maybe no files/locales |
| my $datafiles = shift; |
| if($datafiles) { |
| %datafiles = %{$datafiles}; |
| } |
| } |
| setupOutput($options); |
| setupOptions($options); |
| |
| my($locale, $iter, $data, $program, $args, $variable); |
| # |
| # Outer loop runs through the locales to test |
| # |
| if (%datafiles) { |
| foreach $locale (sort keys %datafiles ) { |
| foreach $data (@{ $datafiles{$locale} }) { |
| closeTable; |
| my $locdata = ""; |
| if(!($locale eq "")) { |
| $locdata = "<b>Locale:</b> $locale<br>"; |
| } |
| $locdata .= "<b>Datafile:</b> $data<br>"; |
| startTest($locdata); |
| |
| if($DATADIR) { |
| compareLoop ($tests, $locale, $DATADIR."/".$data); |
| } else { |
| compareLoop ($tests, $locale, $data); |
| } |
| } |
| } |
| } else { |
| compareLoop($tests); |
| } |
| closeOutput(); |
| } |
| |
| sub compareLoop { |
| #debug("enter compareLoop\n"); |
| |
| my $tests = shift; |
| #debug("tests $tests"); |
| #my @tests = @{$tests}; |
| my %tests = %{$tests}; |
| #debug("tests $tests"); |
| my $locale = shift; |
| my $datafile = shift; |
| my $locAndData = ""; |
| if($locale) { |
| $locAndData .= " -L $locale"; |
| } |
| |
| if($datafile) { |
| $locAndData .= " -f $datafile"; |
| } |
| |
| my $args; |
| my ($i, $j, $aref); |
| foreach $i ( sort keys %tests ) { |
| #debug("Test: $i\n"); |
| $aref = $tests{$i}; |
| my @timedata; |
| my @iterPerPass; |
| my @noopers; |
| my @noevents; |
| |
| my $program; |
| my @argsAndTest; |
| for $j ( 0 .. $#{$aref} ) { |
| # first we calibrate. Use time from somewhere |
| # first test is used for calibration |
| ################## |
| # ($program, @argsAndTest) = split(/\ /, @{ $tests{$i} }[$j]); |
| # #Modified by Doug |
| # my $commandLine; |
| # if ($ITERATIONS) { |
| # $commandLine = "$program -i $ITERATIONS -p $NUMPASSES $locAndData @argsAndTest"; |
| # } else { |
| # $commandLine = "$program -t $TIME -p $NUMPASSES $locAndData @argsAndTest"; |
| # } |
| ###################### |
| ###################### |
| my $custArgs; |
| my $testCommand = @{ $tests{$i} }[$j]; |
| if ($testCommand =~/--/) { |
| $custArgs = $& . $'; #The matched part and the right part |
| $testCommand = $`; #The left part for furthur processing |
| } else { $custArgs = ''; } |
| ($program, @argsAndTest) = split(/\ /, $testCommand); |
| my $commandLine; |
| if ($ITERATIONS) { |
| $commandLine = "$program @argsAndTest -i $ITERATIONS -p $NUMPASSES $locAndData $custArgs"; |
| } else { |
| $commandLine = "$program @argsAndTest -t $TIME -p $NUMPASSES $locAndData $custArgs"; |
| } |
| #debug("custArgs:$custArgs\n"); |
| #################### |
| |
| my @res = measure1($commandLine); |
| store("$i, $program @argsAndTest", @res); |
| |
| push(@iterPerPass, shift(@res)); |
| push(@noopers, shift(@res)); |
| my @data = @{ shift(@res) }; |
| if($#res >= 0) { |
| push(@noevents, shift(@res)); |
| } |
| |
| |
| shift(@data) if (@data > 1); # discard first run |
| |
| #debug("data is @data\n"); |
| my $ds = Dataset->new(@data); |
| |
| push(@timedata, $ds); |
| } |
| |
| outputRow($i, \@iterPerPass, \@noopers, \@timedata, \@noevents); |
| } |
| |
| } |
| |
| #--------------------------------------------------------------------- |
| # Measure a given test method with a give test pattern using the |
| # global run parameters. |
| # |
| # @param the method to run |
| # @param the pattern defining characters to test |
| # @param if >0 then the number of iterations per pass. If <0 then |
| # (negative of) the number of seconds per pass. |
| # |
| # @return array of: |
| # [0] iterations per pass |
| # [1] events per iteration |
| # [2..] ms reported for each pass, in order |
| # |
| sub measure1 { |
| # run passes |
| my @t = callProg(shift); #"$program $args $argsAndTest"); |
| my @ms = (); |
| my @b; # scratch |
| for my $a (@t) { |
| # $a->[0]: method name, corresponds to $method |
| # $a->[1]: 'begin' data, == $iterCount |
| # $a->[2]: 'end' data, of the form <ms> <eventsPerIter> |
| # $a->[3...]: gc messages from JVM during pass |
| @b = split(/\s+/, $a->[2]); |
| #push(@ms, $b[0]); |
| push(@ms, shift(@b)); |
| } |
| my $iterCount = shift(@b); |
| my $operationsPerIter = shift(@b); |
| my $eventsPerIter; |
| if($#b >= 0) { |
| $eventsPerIter = shift(@b); |
| } |
| |
| # out("Iterations per pass: $iterCount<BR>\n"); |
| # out("Events per iteration: $eventsPerIter<BR>\n"); |
| # debug("Iterations per pass: $iterCount<BR>\n"); |
| # if($eventsPerIter) { |
| # debug("Events per iteration: $eventsPerIter<BR>\n"); |
| # } |
| |
| my @ms_str = @ms; |
| $ms_str[0] .= " (discarded)" if (@ms_str > 1); |
| # out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n"); |
| debug("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n"); |
| if($eventsPerIter) { |
| ($iterCount, $operationsPerIter, \@ms, $eventsPerIter); |
| } else { |
| ($iterCount, $operationsPerIter, \@ms); |
| } |
| } |
| |
| |
| |
| #--------------------------------------------------------------------- |
| # Measure a given test method with a give test pattern using the |
| # global run parameters. |
| # |
| # @param the method to run |
| # @param the pattern defining characters to test |
| # @param if >0 then the number of iterations per pass. If <0 then |
| # (negative of) the number of seconds per pass. |
| # |
| # @return a Dataset object, scaled by iterations per pass and |
| # events per iteration, to give time per event |
| # |
| sub measure2 { |
| my @res = measure1(@_); |
| my $iterPerPass = shift(@res); |
| my $operationsPerIter = shift(@res); |
| my @data = @{ shift(@res) }; |
| my $eventsPerIter = shift(@res); |
| |
| |
| shift(@data) if (@data > 1); # discard first run |
| |
| my $ds = Dataset->new(@data); |
| #$ds->setScale(1.0e-3 / ($iterPerPass * $operationsPerIter)); |
| ($ds, $iterPerPass, $operationsPerIter, $eventsPerIter); |
| } |
| |
| |
| #--------------------------------------------------------------------- |
| # Invoke program and capture results, passing it the given parameters. |
| # |
| # @param the method to run |
| # @param the number of iterations, or if negative, the duration |
| # in seconds. If more than on pass is desired, pass in |
| # a string, e.g., "100 100 100". |
| # @param the pattern defining characters to test |
| # |
| # @return an array of results. Each result is an array REF |
| # describing one pass. The array REF contains: |
| # ->[0]: The method name as reported |
| # ->[1]: The params on the '= <meth> begin ...' line |
| # ->[2]: The params on the '= <meth> end ...' line |
| # ->[3..]: GC messages from the JVM, if any |
| # |
| sub callProg { |
| my $cmd = shift; |
| #my $pat = shift; |
| #my $n = shift; |
| |
| #my $cmd = "java -cp c:\\dev\\myicu4j\\classes $TESTCLASS $method $n $pat"; |
| debug( "[$cmd]\n"); # for debugging |
| open(PIPE, "$cmd|") or die "Can't run \"$cmd\""; |
| my @out; |
| while (<PIPE>) { |
| push(@out, $_); |
| } |
| close(PIPE) or die "Program failed: \"$cmd\""; |
| |
| @out = grep(!/^\#/, @out); # filter out comments |
| |
| #debug( "[", join("\n", @out), "]\n"); |
| |
| my @results; |
| my $method = ''; |
| my $data = []; |
| foreach (@out) { |
| next unless (/\S/); |
| |
| if (/^=\s*(\w+)\s*(\w+)\s*(.*)/) { |
| my ($m, $state, $d) = ($1, $2, $3); |
| #debug ("$_ => [[$m $state !!!$d!!! $data ]]\n"); |
| if ($state eq 'begin') { |
| die "$method was begun but not finished" if ($method); |
| $method = $m; |
| push(@$data, $d); |
| push(@$data, ''); # placeholder for end data |
| } elsif ($state eq 'end') { |
| if ($m ne $method) { |
| die "$method end does not match: $_"; |
| } |
| $data->[1] = $d; # insert end data at [1] |
| #debug( "#$method:", join(";",@$data), "\n"); |
| unshift(@$data, $method); # add method to start |
| push(@results, $data); |
| $method = ''; |
| $data = []; |
| } else { |
| die "Can't parse: $_"; |
| } |
| } |
| |
| elsif (/^\[/) { |
| if ($method) { |
| push(@$data, $_); |
| } else { |
| # ignore extraneous GC notices |
| } |
| } |
| |
| else { |
| die "Can't parse: $_"; |
| } |
| } |
| |
| die "$method was begun but not finished" if ($method); |
| |
| @results; |
| } |
| |
| sub debug { |
| my $message; |
| if($DEBUG != 0) { |
| foreach $message (@_) { |
| print STDERR "$message"; |
| } |
| } |
| } |
| |
| sub measure1Alan { |
| #Added here, was global |
| my $CALIBRATE = 2; # duration in seconds for initial calibration |
| |
| my $method = shift; |
| my $pat = shift; |
| my $iterCount = shift; # actually might be -seconds/pass |
| |
| out("<P>Measuring $method using $pat, "); |
| if ($iterCount > 0) { |
| out("$iterCount iterations/pass, $NUMPASSES passes</P>\n"); |
| } else { |
| out(-$iterCount, " seconds/pass, $NUMPASSES passes</P>\n"); |
| } |
| |
| # is $iterCount actually -seconds? |
| if ($iterCount < 0) { |
| |
| # calibrate: estimate ms/iteration |
| print "Calibrating..."; |
| my @t = callJava($method, $pat, -$CALIBRATE); |
| print "done.\n"; |
| |
| my @data = split(/\s+/, $t[0]->[2]); |
| my $timePerIter = 1.0e-3 * $data[0] / $data[2]; |
| |
| # determine iterations/pass |
| $iterCount = int(-$iterCount / $timePerIter + 0.5); |
| |
| out("<P>Calibration pass ($CALIBRATE sec): "); |
| out("$data[0] ms, "); |
| out("$data[2] iterations = "); |
| out(formatSeconds(4, $timePerIter), "/iteration<BR>\n"); |
| } |
| |
| # run passes |
| print "Measuring $iterCount iterations x $NUMPASSES passes..."; |
| my @t = callJava($method, $pat, "$iterCount " x $NUMPASSES); |
| print "done.\n"; |
| my @ms = (); |
| my @b; # scratch |
| for my $a (@t) { |
| # $a->[0]: method name, corresponds to $method |
| # $a->[1]: 'begin' data, == $iterCount |
| # $a->[2]: 'end' data, of the form <ms> <eventsPerIter> |
| # $a->[3...]: gc messages from JVM during pass |
| @b = split(/\s+/, $a->[2]); |
| push(@ms, $b[0]); |
| } |
| my $eventsPerIter = $b[1]; |
| |
| out("Iterations per pass: $iterCount<BR>\n"); |
| out("Events per iteration: $eventsPerIter<BR>\n"); |
| |
| my @ms_str = @ms; |
| $ms_str[0] .= " (discarded)" if (@ms_str > 1); |
| out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n"); |
| |
| ($iterCount, $eventsPerIter, @ms); |
| } |
| |
| |
| 1; |
| |
| #eof |