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