#!/usr/local/bin/perl # ******************************************************************** # * Copyright (C) 2016 and later: Unicode, Inc. and others. # * License & terms of use: http://www.unicode.org/copyright.html#License # ******************************************************************** # ******************************************************************** # * COPYRIGHT: # * Copyright (c) 2002, International Business Machines Corporation and # * others. All Rights Reserved. # ******************************************************************** use strict; use Dataset; my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"'; my $outType = "HTML"; my $html = "noName"; my $inTable; my @headers; my @timetypes = ("mean per op", "error per op", "events", "per event"); my %raw; my $current = ""; my $exp = 0; my $mult = 1e9; #use nanoseconds my $perc = 100; #for percent my $printEvents = 0; my $legend = "\n

Table legend

\n"; print HTML $legend; outputRaw(); print HTML < EOF close(HTML) or die "Can't close $html: $!"; } } sub outputRaw { print HTML "

Raw data

"; my $key; my $i; my $j; my $k; print HTML "\n"; for $key (sort keys %raw) { my $printkey = $key; $printkey =~ s/\/ /g; if($printEvents) { if($key ne "") { print HTML "\n"; # locale and data file } print HTML "\n"; } else { if($key ne "") { print HTML "\n"; # locale and data file } print HTML "\n"; } $printkey =~ s/[\<\>\/ ]//g; my %done; for $i ( $raw{$key} ) { print HTML ""; for $j ( @$i ) { my ($test, $args); ($test, $args) = split(/,/, shift(@$j)); print HTML ""; print HTML ""; print HTML ""; print HTML ""; my @data = @{ shift(@$j) }; my $ds = Dataset->new(@data); print HTML ""; if($#{ $j } >= 0) { print HTML ""; } print HTML "\n"; } } } } sub store { $raw{$current}[$exp++] = [@_]; } sub outputRow { #$raw{$current}[$exp++] = [@_]; my $testName = shift; my @iterPerPass = @{shift(@_)}; my @noopers = @{shift(@_)}; my @timedata = @{shift(@_)}; my @noevents; if($#_ >= 0) { @noevents = @{shift(@_)}; } if(!$inTable) { if(@noevents) { $printEvents = 1; startTable; } else { startTable; } } debug("No events: @noevents, $#noevents\n"); my $j; my $loc = $current; $loc =~ s/\/ /g; $loc =~ s/[\<\>\/ ]//g; # Finished one row of results. Outputting newRow; #outputData($testName, "LEFT"); print HTML "\n"; #outputData($iterCount); #outputData($noopers[0], "RIGHT"); outputValue($noopers[0]); if(!$printEvents) { for $j ( 0 .. $#timedata ) { my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation #debug("Time per operation: ".formatSeconds(4, $perOperation->getMean, $perOperation->getError)."\n"); outputDist($perOperation); } } my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noopers[0]); for $j ( 1 .. $#timedata ) { my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation my $ratio = $baseLinePO->subtract($perOperation); $ratio = $ratio->divide($perOperation); outputDist($ratio, "%"); } if (@noevents) { for $j ( 0 .. $#timedata ) { #outputData($noevents[$j], "RIGHT"); outputValue($noevents[$j]); } for $j ( 0 .. $#timedata ) { my $perEvent = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per event #debug("Time per operation: ".formatSeconds(4, $perEvent->getMean, $perEvent->getError)."\n"); outputDist($perEvent); } my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noevents[0]); for $j ( 1 .. $#timedata ) { my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per operation my $ratio = $baseLinePO->subtract($perOperation); $ratio = $ratio->divide($perOperation); outputDist($ratio, "%"); } } } 1; #eof
$printkey
test nameinteresting argumentsiterationsoperationsmean time (ns)error (ns)events
$printkey
test nameinteresting argumentsiterationsoperationsmean time (ns)error (ns)
"; if(!$done{$test}) { print HTML "".$test.""; $done{$test} = 1; } else { print HTML $test; } print HTML "".$args."".shift(@$j)."".shift(@$j)."".formatNumber(4, $mult, $ds->getMean)."".formatNumber(4, $mult, $ds->getError)."".shift(@$j)."
$testName