Home | History | Annotate | Download | only in perldriver 
      1 #!/usr/local/bin/perl
      2 
      3 #  ********************************************************************
      4 #  * COPYRIGHT:
      5 #  *  2016 and later: Unicode, Inc. and others.
      6 #  * License & terms of use: http://www.unicode.org/copyright.html#License
      7 #  * Copyright (c) 2006, International Business Machines Corporation and
      8 #  * others. All Rights Reserved.
      9 #  ********************************************************************
     10 
     11 
     12 use strict;
     13 
     14 use Dataset;
     15 
     16 my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
     17 my $outType = "HTML";
     18 my $html = "noName";
     19 my $inTable;
     20 my @headers;
     21 my @timetypes = ("mean per op", "error per op", "events", "per event");
     22 my %raw;
     23 my $current = "";
     24 my $exp = 0;
     25 my $mult = 1e9; #use nanoseconds
     26 my $perc = 100; #for percent
     27 my $printEvents = 0;
     28 my $legend = "<a name=\"Legend\">\n<h2>Table legend</h2></a><ul>";
     29 my $legendDone = 0;
     30 my %options;
     31 my $operationIs = "operation";
     32 my $eventIs = "event";
     33 
     34 sub startTest {
     35   $current = shift;
     36   $exp = 0;
     37   outputData($current);
     38 }
     39 
     40 sub printLeg {
     41   if(!$legendDone) {
     42     my $message;
     43     foreach $message (@_) {
     44       $legend .= "<li>".$message."</li>\n";
     45     }
     46   }
     47 }
     48 
     49 sub outputDist {
     50   my $value = shift;
     51   my $percent = shift;
     52   my $mean = $value->getMean;
     53   my $error = $value->getError;
     54   print HTML "<td class=\"";
     55   if($mean > 0) {
     56     print HTML "value";
     57   } else {
     58     print HTML "worse";
     59   }
     60   print HTML "\">";
     61   if($percent) {
     62     print HTML formatPercent(2, $mean);
     63   } else {
     64     print HTML formatNumber(2, $mult, $mean);
     65   }
     66   print HTML "</td>\n";  
     67   print HTML "<td class=\"";
     68   if((($error*$mult < 10)&&!$percent) || (($error<10)&&$percent)) {
     69     print HTML "error";
     70   } else {
     71     print HTML "errorLarge";
     72   }
     73   print HTML "\">&plusmn;";
     74   if($percent) {
     75     print HTML formatPercent(2, $error);
     76   } else {
     77     print HTML formatNumber(2, $mult, $error);
     78   }
     79   print HTML "</td>\n";  
     80 }
     81   
     82 sub outputValue {
     83   my $value = shift;
     84   print HTML "<td class=\"sepvalue\">";
     85   print HTML $value;
     86   #print HTML formatNumber(2, 1, $value);
     87   print HTML "</td>\n";  
     88 }
     89 
     90 sub startTable {
     91   #my $printEvents = shift;
     92   $inTable = 1;
     93   my $i;
     94   print HTML "<table $TABLEATTR>\n";
     95   print HTML "<tbody>\n";
     96   if($#headers >= 0) {
     97     my ($header, $i);
     98     print HTML "<tr>\n";
     99     print HTML "<th rowspan=\"2\" class=\"testNameHeader\"><a href=\"#TestName\">Test Name</a></th>\n";
    100     print HTML "<th rowspan=\"2\" class=\"testNameHeader\"><a href=\"#Ops\">Ops</a></th>\n";
    101     printLeg("<a name=\"Test Name\">TestName</a> - name of the test as set by the test writer\n", "<a name=\"Ops\">Ops</a> - number of ".$operationIs."s per iteration\n");
    102     if(!$printEvents) {
    103       print HTML "<th colspan=".((4*($#headers+1))-2)." class=\"sourceType\">Per Operation</th>\n";
    104     } else {
    105       print HTML "<th colspan=".((2*($#headers+1))-2)." class=\"sourceType\">Per Operation</th>\n";
    106       print HTML "<th colspan=".((5*($#headers+1))-2)." class=\"sourceType\">Per Event</th>\n";
    107     }
    108     print HTML "</tr>\n<tr>\n";
    109     if(!$printEvents) {
    110       foreach $header (@headers) {
    111 	print HTML "<th class=\"source\" colspan=2><a href=\"#meanop_$header\">$header<br>/op</a></th>\n";
    112 	printLeg("<a name=\"meanop_$header\">$header /op</a> - mean time and error for $header per $operationIs");
    113       }
    114     }
    115     for $i (1 .. $#headers) {
    116       print HTML "<th class=\"source\" colspan=2><a href=\"#mean_op_$i\">ratio $i<br>/op</a></th>\n";
    117       printLeg("<a name=\"mean_op_$i\">ratio $i /op</a> - ratio and error of per $operationIs time, calculated as: (($headers[0] - $headers[$i])/$headers[$i])*100%, mean value");
    118     }
    119     if($printEvents) {
    120       foreach $header (@headers) {
    121 	print HTML "<th class=\"source\"><a href=\"#events_$header\">$header<br>events</a></th>\n";
    122 	printLeg("<a name=\"events_$header\">$header events</a> - number of ".$eventIs."s for $header per iteration");
    123       }
    124       foreach $header (@headers) {
    125 	print HTML "<th class=\"source\" colspan=2><a href=\"#mean_ev_$header\">$header<br>/ev</a></th>\n";
    126 	printLeg("<a name=\"mean_ev_$header\">$header /ev</a> - mean time and error for $header per $eventIs");
    127       }
    128       for $i (1 .. $#headers) {
    129 	print HTML "<th class=\"source\" colspan=2><a href=\"#mean_ev_$i\">ratio $i<br>/ev</a></th>\n";
    130 	printLeg("<a name=\"mean_ev_$i\">ratio $i /ev</a> - ratio and error of per $eventIs time, calculated as: (($headers[0] - $headers[$i])/$headers[$i])*100%, mean value");
    131       }
    132     }
    133     print HTML "</tr>\n";
    134   }
    135   $legendDone = 1;
    136 }
    137 
    138 sub closeTable {
    139   if($inTable) {
    140     undef $inTable;
    141     print HTML "</tr>\n";
    142     print HTML "</tbody>";
    143     print HTML "</table>\n";
    144   }
    145 }
    146 
    147 sub newRow {
    148   if(!$inTable) {
    149     startTable;
    150   } else {
    151     print HTML "</tr>\n";
    152   }
    153   print HTML "<tr>";
    154 }
    155 
    156 sub outputData {
    157   if($inTable) {
    158     my $msg = shift;
    159     my $align = shift;
    160     print HTML "<td";
    161     if($align) {
    162       print HTML " align = $align>";
    163     } else {
    164       print HTML ">";
    165     }
    166     print HTML "$msg";
    167     print HTML "</td>";
    168   } else {
    169     my $message;
    170     foreach $message (@_) {
    171       print HTML "$message";
    172     }
    173   }
    174 }
    175 
    176 sub setupOutput {
    177   my $date = localtime;
    178   my $options = shift;
    179   %options = %{ $options };
    180   my $title = $options{ "title" };
    181   my $headers = $options{ "headers" };
    182   if($options{ "operationIs" }) {
    183     $operationIs = $options{ "operationIs" };
    184   }
    185   if($options{ "eventIs" }) {
    186     $eventIs = $options{ "eventIs" };
    187   }
    188   @headers = split(/ /, $headers);
    189   my ($t, $rest);
    190   ($t, $rest) = split(/\.\w+/, $0);
    191   $t =~ /^.*\W(\w+)$/;
    192   $t = $1;
    193   if($outType eq 'HTML') {
    194     $html = $date;
    195     $html =~ s/://g; # ':' illegal
    196     $html =~ s/\s*\d+$//; # delete year
    197     $html =~ s/^\w+\s*//; # delete dow
    198     $html = "$t $html.html";
    199     if($options{ "outputDir" }) {
    200       $html = $options{ "outputDir" }."/".$html;
    201     }
    202     $html =~ s/ /_/g;
    203 
    204     open(HTML,">$html") or die "Can't write to $html: $!";
    205 
    206 #<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
    207     print HTML <<EOF;
    208 <HTML>
    209    <HEAD>
    210    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
    211       <TITLE>$title</TITLE>
    212 <style>
    213 <!--
    214 body         { font-size: 10pt; font-family: sans-serif }
    215 th           { font-size: 10pt; border: 0 solid #000080; padding: 5 }
    216 th.testNameHeader { border-width: 1 }
    217 th.testName  { text-align: left; border-left-width: 1; border-right-width: 1; 
    218                border-bottom-width: 1 }
    219 th.source    { border-right-width: 1; border-bottom-width: 1 }
    220 th.sourceType { border-right-width: 1; border-top-width: 1; border-bottom-width: 1 }
    221 td           { font-size: 10pt; text-align: Right; border: 0 solid #000080; padding: 5 }
    222 td.string    { text-align: Left; border-bottom-width:1; border-right-width:1 }
    223 td.sepvalue  { border-bottom-width: 1; border-right-width: 1 }
    224 td.value     { border-bottom-width: 1 }
    225 td.worse     { color: #FF0000; font-weight: bold; border-bottom-width: 1 }
    226 td.error     { font-size: 75%; border-right-width: 1; border-bottom-width: 1 }
    227 td.errorLarge { font-size: 75%; color: #FF0000; font-weight: bold; border-right-width: 1; 
    228                border-bottom-width: 1 }
    229 A:link    { color: black; font-weight: normal; text-decoration: none}    /* unvisited links */
    230 A:visited { color: blue; font-weight: normal; text-decoration: none }   /* visited links   */
    231 A:hover   { color: red; font-weight: normal; text-decoration: none } /* user hovers     */
    232 A:active  { color: lime; font-weight: normal; text-decoration: none }   /* active links    */
    233 -->
    234 </style>
    235    </HEAD>
    236    <BODY bgcolor="#FFFFFF" LINK="#006666" VLINK="#000000">
    237 EOF
    238     print HTML "<H1>$title</H1>\n";
    239 
    240     #print HTML "<H2>$TESTCLASS</H2>\n";
    241   }
    242 }
    243 
    244 sub closeOutput {
    245   if($outType eq 'HTML') {
    246     if($inTable) {
    247       closeTable;
    248     }
    249     $legend .= "</ul>\n";
    250     print HTML $legend;
    251     outputRaw();
    252     print HTML <<EOF;
    253    </BODY>
    254 </HTML>
    255 EOF
    256     close(HTML) or die "Can't close $html: $!";
    257   }
    258 }
    259 
    260 
    261 sub outputRaw {
    262   print HTML "<h2>Raw data</h2>";
    263   my $key;
    264   my $i;
    265   my $j;
    266   my $k;
    267   print HTML "<table $TABLEATTR>\n";
    268   for $key (sort keys %raw) {
    269     my $printkey = $key;
    270     $printkey =~ s/\<br\>/ /g;
    271     if($printEvents) {
    272       if($key ne "") {
    273 	print HTML "<tr><th class=\"testNameHeader\" colspan = 7>$printkey</td></tr>\n"; # locale and data file
    274       }
    275       print HTML "<tr><th class=\"testName\">test name</th><th class=\"testName\">interesting arguments</th><th class=\"testName\">iterations</th><th class=\"testName\">operations</th><th class=\"testName\">mean time (ns)</th><th class=\"testName\">error (ns)</th><th class=\"testName\">events</th></tr>\n";
    276     } else {
    277       if($key ne "") {
    278 	print HTML "<tr><th class=\"testName\" colspan = 6>$printkey</td></tr>\n"; # locale and data file
    279       }
    280       print HTML "<tr><th class=\"testName\">test name</th><th class=\"testName\">interesting arguments</th><th class=\"testName\">iterations</th><th class=\"testName\">operations</th><th class=\"testName\">mean time (ns)</th><th class=\"testName\">error (ns)</th></tr>\n";
    281     }
    282     $printkey =~ s/[\<\>\/ ]//g;
    283       
    284     my %done;
    285     for $i ( $raw{$key} ) {
    286       print HTML "<tr>";
    287       for $j ( @$i ) {
    288 	my ($test, $args);
    289 	($test, $args) = split(/,/, shift(@$j));
    290 
    291 	print HTML "<th class=\"testName\">";
    292 	if(!$done{$test}) {
    293 	  print HTML "<a name=\"".$printkey."_".$test."\">".$test."</a>";
    294 	  $done{$test} = 1;
    295 	} else {
    296 	  print HTML $test;
    297 	}
    298 	print HTML "</th>";
    299 
    300 	print HTML "<td class=\"string\">".$args."</td>";
    301 	
    302 	print HTML "<td class=\"sepvalue\">".shift(@$j)."</td>";
    303 	print HTML "<td class=\"sepvalue\">".shift(@$j)."</td>";
    304 
    305 	my @data = @{ shift(@$j) };
    306 	my $ds = Dataset->new(@data);
    307 	print HTML "<td class=\"sepvalue\">".formatNumber(4, $mult, $ds->getMean)."</td><td class=\"sepvalue\">".formatNumber(4, $mult, $ds->getError)."</td>";
    308 	if($#{ $j } >= 0) {
    309 	  print HTML "<td class=\"sepvalue\">".shift(@$j)."</td>";
    310 	}
    311 	print HTML "</tr>\n";
    312       }
    313     }
    314   }
    315 }
    316 
    317 sub store {
    318   $raw{$current}[$exp++] = [@_];
    319 }
    320 
    321 sub outputRow {
    322   #$raw{$current}[$exp++] =  [@_];
    323   my $testName = shift;
    324   my @iterPerPass = @{shift(@_)};
    325   my @noopers =  @{shift(@_)};
    326    my @timedata =  @{shift(@_)};
    327   my @noevents;
    328   if($#_ >= 0) {
    329     @noevents =  @{shift(@_)};
    330   }
    331   if(!$inTable) {
    332     if(@noevents) {
    333       $printEvents = 1;
    334       startTable;
    335     } else {
    336       startTable;
    337     }
    338   }
    339   debug("No events: @noevents, $#noevents\n");
    340 
    341   my $j;
    342   my $loc = $current;
    343   $loc =~ s/\<br\>/ /g;
    344   $loc =~ s/[\<\>\/ ]//g;
    345 
    346   # Finished one row of results. Outputting
    347   newRow;
    348   #outputData($testName, "LEFT");
    349   print HTML "<th class=\"testName\"><a href=\"#".$loc."_".$testName."\">$testName</a></th>\n";
    350   #outputData($iterCount);
    351   #outputData($noopers[0], "RIGHT");
    352   outputValue($noopers[0]);
    353 
    354   if(!$printEvents) {
    355     for $j ( 0 .. $#timedata ) {
    356       my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation
    357       #debug("Time per operation: ".formatSeconds(4, $perOperation->getMean, $perOperation->getError)."\n");
    358       outputDist($perOperation);
    359     }
    360   }
    361   my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noopers[0]);
    362   for $j ( 1 .. $#timedata ) {
    363     my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation
    364     my $ratio = $baseLinePO->subtract($perOperation);
    365     $ratio = $ratio->divide($perOperation);
    366     outputDist($ratio, "%");
    367   }   
    368   if (@noevents) {
    369     for $j ( 0 .. $#timedata ) {
    370       #outputData($noevents[$j], "RIGHT");
    371       outputValue($noevents[$j]);
    372     }
    373     for $j ( 0 .. $#timedata ) {
    374       my $perEvent =  $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per event
    375       #debug("Time per operation: ".formatSeconds(4, $perEvent->getMean, $perEvent->getError)."\n");
    376       outputDist($perEvent);
    377     }   
    378     my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noevents[0]);
    379     for $j ( 1 .. $#timedata ) {
    380       my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per operation
    381       my $ratio = $baseLinePO->subtract($perOperation);
    382       $ratio = $ratio->divide($perOperation);
    383       outputDist($ratio, "%");
    384     }   
    385   }
    386 }
    387 
    388 
    389 1;
    390 
    391 #eof
    392