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