# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# This program is distributed with GNU Go, a Go program. #
# Write gnugo@gnu.org or see http://www.gnu.org/software/gnugo/ #
# for more information. #
# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 #
# and 2008 by the Free Software Foundation. #
# This program is free software; you can redistribute it and/or #
# modify it under the terms of the GNU General Public License #
# as published by the Free Software Foundation - version 3 #
# or (at your option) any later version. #
# This program is distributed in the hope that it will be #
# useful, but WITHOUT ANY WARRANTY; without even the implied #
# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR #
# PURPOSE. See the GNU General Public License in file COPYING #
# You should have received a copy of the GNU General Public #
# License along with this program; if not, write to the Free #
# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, #
# Boston, MA 02111, USA. #
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Here is a perlscript regress.plx.
# It parses the XML files created by regress.pl and generates HTML.
# It is designed to be run as a CGI script.
# use CGI::Carp qw(carpout);
# my $errfile = "C:/temp/web.err";
# #open (WEBERR, ">$errfile") or die "Couldn't open $errfile.";
use CGI
::Carp
'fatalsToBrowser';
use lib
"$FindBin::Bin/../interface";
use HTML
::Entities
;#qw/encode_entity/;
#set $name to whatever this script is called in the URL.
#eg, if you access it from http://example.com/regress/
my $name = "regress.plx";
my %colors = ("ALIVE", "green",
my ($tstfile, $num, $sortby, $sgf, $reset, $trace, $bycat,
$unexpected, $slow, $special, $move, $small);
($tstfile, $num) = ($query->query_string() =~ /keywords=(.*)%3A(.*)/);
$tstfile = $query->param("tstfile");
$num = $query->param("num");
$sortby = $query->param("sortby");
$sgf = $query->param("sgf");
$reset = $query->param("reset");
$trace = $query->param("trace");
$bycat = $query->param("bycat");
$unexpected = $query->param("unexpected");
$slow = $query->param("slow");
$special = $query->param("special");
$move = $query->param("move");
$small = $query->param("small");
#print "HTTP/1.0 200 OK\r\n";
if ($sgf) { "application/x-go-sgf" }
elsif ($plain) { "text/plain" }
$tstfile = $1 if $tstfile =~ /(.*)\.tst$/;
if ($tstfile && !($tstfile =~ /^[a-zA-Z0-9_]+$/)) {
print "bad test file: $tstfile\n";
unlink glob("html/*.html");# or die "couldn't delete html files: $!";
unlink glob("html/*/*.html");# or die "couldn't delete html/* files: $!";
unlink "html/one.perldata";# or die "couldn't delete data file";
print "Cleaned up!<HR>\n";
open (TRACER
, "html/$tstfile.tst/$num.trace") or
do {print "Couldn't find trace file: $!"; exit;};
if (!-e
"html/index.html") {
print STDERR
"Cached!\n";
if (-z
"html/index.html") {
print "Yikes - index missing - please reset!";
open (TESTFILE
, "html/index.html") or do {print "$! ".__LINE__
; confess
"$!"};
open (FILE
, ">html/one.perldata.new") or confess
"can't open";
print FILE
"\$VAR1 = [\n {\n";
#print FILE Dumper([\%h]) or confess "couldn't print";
foreach my $k1 (sort keys %{$h}) {
print FILE
" '$k1' =>\n {\n";
foreach my $k2 (sort keys %{%{$h}->{$k1}}) {
print FILE
" '$k2' => " . insinglequote
(%{$h}->{$k1}->{$k2}) . ",\n";
close FILE
or confess
"can't close";
foreach my $file (glob("html/*.tst/*.xml")) {
my ($tst, $prob) = $file =~ m
@html.(.*).tst
.(.*).xml@
;
$h{"$tst:$prob"} = game_parse
($content, 0);
delete $h{"$tst:$prob"}->{gtp_all
};
#do "html/one.perldata" or confess "can't do perldata";
open I
, ">html/index.html";
<TITLE
>Regression test summary
- </TITLE
>
<META NAME
="ROBOTS" CONTENT
="NOFOLLOW">
<H3
> Regression test summary
- </H3
>
Program
: _CMDLINE_TBD_
<BR
>
<A href
="$name?bycat=1">View by category
</A
><BR
>
<A href
="$name?unexpected=1">View unexpected results
</A
><BR
>
<TR
><TD
>file
</TD><TD>passed</TD
><TD
>PASSED
</TD><TD>failed</TD
><TD
>FAILED
</TD
>
my @pflist = ("passed", "PASSED", "failed", "FAILED");
@totHash{@pflist} = (0,0,0,0);
my ($fileA,$numA) = $a =~ /(.*):(.*)/;
my ($fileB,$numB) = $b =~ /(.*):(.*)/;
$fileA cmp $fileB or $numA <=> $numB;
foreach my $k1 (sort byfilebynum
keys %h) { #$k1 = filename
if ($k1 !~ /^$curfile:/) {
#New file = print old totals
print I
qq@
<TR
>\n <TD
><A href
="$name?tstfile=$curfile&sortby=result">$curfile</A></TD
>\n@
;
foreach my $k2 (@pflist) {
my $c = @
{$subTotHash{$k2}}; #i.e. length of array.
if ($k2 !~ /passed/ and $c) {
print I
" <TD>$c:<BR>\n";
foreach (sort {$a<=>$b} @
{$subTotHash{$k2}}) {
print I
qq@
<A href
="$name?$curfile:$_">$_</A
>\n@
;
print I
" <TD>$c</TD>\n";
($curfile) = $k1 =~ /(.*):/;
@subTotHash{@pflist} = ([],[],[],[]);
push @
{$subTotHash{$h{$k1}{status
}}}, $h{$k1}{num
};
#direct copy from above - don't miss last time through - HACK!
#New file = print old totals
print I
qq@
<TR
>\n <TD
><A href
="$name?tstfile=$curfile&sortby=result">$curfile</A></TD
>\n@
;
foreach my $k2 (@pflist) {
my $c = @
{$subTotHash{$k2}}; #i.e. length of array.
if ($k2 !~ /passed/ and $c) {
print I
" <TD>$c:<BR>\n";
foreach (sort {$a<=>$b} @
{$subTotHash{$k2}}) {
print I
qq@
<A href
="$name?$curfile:$_">$_</A
>\n@
;
print I
" <TD>$c</TD>\n";
print I
"<TR>\n <TD><B>Total</B></TD>\n";
print I
" <TD>$totHash{$_}</TD>\n";
print I
" </TABLE></BODY></HTML>\n";
pPfFtonum
($a) <=> pPfFtonum
($b);
s/FAILED/4/; s/failed/3/; s/PASSED/2/; s/passed/1/;
s/FAILED/1/; s/failed/3/; s/PASSED/2/; s/passed/4/; s/<B>//; s@
</B
>@@
;
my @counters = qw
/connection_node owl_node reading_node trymove/;
#CASE 2a - move detail - extract interesting info from trace file.
print "Must provide num if providing move.<BR>";
<TITLE
>$tstfile:$num move
$move</TITLE
>
<META NAME
="ROBOTS" CONTENT
="NOINDEX, NOFOLLOW">
open (FILE
, "html/$tstfile.tst/$num.trace") or die "couldn't open trace file $tstfile, $num: $!.";
/[^A-Za-z0-9]$move[^0-9]/ ||
$inpattern && /^\.\.\./) {
print encode_entities
($_);
$inpattern ||= /^pattern.*at $move/;
print "\n" unless $blank;
print "</PRE></BODY></HTML>\n";
#CASE 2 - problem detail.
if ($sgf && -e
"html/$tstfile.tst/$num.sgf") {
open (SGFFILE
, "html/$tstfile.tst/$num.sgf") or confess
"couldn't open file";
open (FILE
, "html/$tstfile.tst/$num.xml") or die "couldn't open xml file\n";
my %attribs = %{game_parse
($content, 1)};
foreach (sort keys %attribs) {
# print "$_: $attribs{$_}\n";
<TITLE
>$tstfile:$num details
.</TITLE
>
<META NAME
="ROBOTS" CONTENT
="NOINDEX, NOFOLLOW">
print qq@
<BODY
><TABLE border
=1>\n@
;
<TD
>number
:</TD><TD>$attribs{"num"}</TD
><TD
> 
;</TD
>
<TD
>cputime
:</TD><TD>$attribs{"cputime"}</TD
>
<TD
>status
:</TD><TD>$attribs{"status"}</TD
><TD
> 
;</TD
>
<TD
>$counters[0]:</TD><TD>$attribs{"$counters[0]_counter"}</TD
>
<TD
>correct
:</TD><TD>$attribs{"correct"}</TD
><TD
> 
;</TD
>
<TD
>$counters[1]:</TD><TD>$attribs{"$counters[1]_counter"}</TD
>
<TD
>answer
:</TD><TD>$attribs{"answer"}</TD
><TD
> 
;</TD
>
<TD
>$counters[2]:</TD><TD>$attribs{"$counters[2]_counter"}</TD
>
<TD
>gtp
:</TD><TD>$attribs{"gtp_command"}</TD
><TD
> 
;</TD
>
<TD
>$counters[3]:</TD><TD>$attribs{"$counters[3]_counter"}</TD
>
</TR><TR><TD>category:</TD
><TD
>$attribs{"category"}</TD
>
</TR><TR><TD>severity:</TD
><TD
>$attribs{"severity"}</TD
>
</TR><TR><TD>description:</TD
><TD
>$attribs{"description"}</TD
>
<TR
><TD
><A href
="$name?tstfile=$tstfile&num=$num&sgf=1">SGF File
</A
>
</TD><TD> <A href="$name?tstfile=$tstfile&num=$num&trace=1" target=tracefile>Trace File</A
>
print qq@
<TABLE
><TR
><TD
> dragon_status
| owl_status
\n@
;
my $boardsize = $attribs{"boardsize"}; #need to add to export.
$colorboard .= "<TABLE border=0 cellpadding=0 cellspacing=0>\n"
. colorboard_letter_row
($boardsize). "\n";
for (my $j = $boardsize; $j > 0; $j--) {
$colorboard .= " <TR>\n <TD align=center valign=center> $j </TD>\n";
for (my $i = 1; $i <= $boardsize; $i++) {
my $iA = ord('A') + $i - 1;
if ($iA >= ord('I')) { $iA++; }
my $bw = pval
($coord, "stone");
my $dragonletter = pval
($coord, "dragon_letter");
my $dragoncolor = $colors{pval
($coord, "dragon_status")};
my $owlcolor = $colors{pval
($coord, "owl_status")};
my $owlletter = $dragonletter;
my ($markcolor, $known, $try) = ("", pval
($coord, "known"), pval
($coord, "try"));
$markcolor = "magenta" if ($known and $known eq "wrong");
$markcolor = "green" if ($known and $known eq "right");
$markcolor = "cyan" if ($try and $try eq "right");
$markcolor = "red" if ($try and $try eq "wrong");
my $question = pval
($coord, "question");
$dragoncolor = "blue" unless $dragoncolor;
my $score = pval
($coord, "move_value");
# FIXME: Should round this, not truncate it.
# Also, should remove trailing "." if not necessary.
$dragonletter = substr($score, 0,3);
my $colorboard_imgsrc = createPngFile
($bw, $img_pix_size, "", $dragonletter, $dragoncolor, $owlletter, $owlcolor, $markcolor);
$colorboard .= qq@
<TD
><A href
="$name?tstfile=$tstfile&num=$num&move=$coord" target
=movewin
>@
.
qq@
<IMG border
=0 HEIGHT
=$img_pix_size WIDTH
=$img_pix_size @
.
qq@SRC="html/images/$colorboard_imgsrc"></A></TD
>\n@
;
$colorboard .= " <TD align=center valign=center> $j </TD>\n </TR>\n";
$colorboard .= colorboard_letter_row
($boardsize);
$colorboard .= "\n</TABLE>\n";
print qq@
</TD
><TD valign
=top
>
<FONT color
=green
>green
=alive
</FONT
>
<FONT color
=cyan
>cyan
=dead
</FONT
>
<FONT color
=red
>red
=critical
</FONT
>
<FONT color
=yellow
>yellow
=unknown
</FONT
>
<FONT color
=magenta
>magenta
=unchecked
</FONT
>
my $gtpall = $attribs{gtp_all
};
$gtpall =~ m
@loadsgf\s
+ ((?
:\w
|[-+.\\/])+) [ \t]* (\d
*) @x
or $gtpall =~m/(.*?)/; #Problems!!!!
my $cmdline = "gq -l $1 " . ($2 ?
"-L $2 " : "");
if ($gtpall =~ m@
.* (owl_attack
|owl_defend
|dragon_status
) \s
* ([A
-Z
]\d
{1,2}) \s
* $ @x) {
$cmdline .= "--decide-dragon $2 -o x.sgf" ;
} elsif ($gtpall =~ m@
.* (reg_genmove\s
+[whiteblack
]*) \s
* $@x) {
$cmdline .= "-t -w -d0x101800";
} elsif ($gtpall =~ m@
.* (attack
|defend
) \s
* ([A
-Z
]\d
{1,2}) \s
* $ @x) {
$cmdline .= "--decide-string $2 -o x.sgf";
$cmdline .= " <BR> (directive unrecognized)";
print qq@
<TABLE border
=1>\n@
;
print qq@
<TR
><TD
>CMD Line Hint
:</TD><TD>$cmdline</TD
></TR
>\n@
;
print qq@
<TR
><TD
>Full GTP
:</TD><TD>$attribs{gtp_all}</TD
></TR>\n</TABLE
>\n@
;
#CASE 3 - test file summary.
# if (!-e "html/$tstfile.tst/index.html") {
# open (TESTFILE, "html/$tstfile.tst/index.html") or (print "$! ".__LINE__, die);
foreach my $curfile (glob("html/$tstfile.tst/*.xml"))
$curfile =~ s/html.$tstfile.tst.(.*xml)/$1/;
open(FILE
, "html/$tstfile.tst/$curfile");
my %attribs = %{game_parse
($content, 1)};
print qq@
<HR
><A href
="$name?$tstfile:$attribs{num}">$tstfile:$attribs{num
}</A
>\n@
;
my $boardsize = $attribs{"boardsize"}; #need to add to export.
$colorboard .= "<TABLE border=0 cellpadding=0 cellspacing=0>\n"
for (my $j = $boardsize; $j > 0; $j--) {
for (my $i = 1; $i <= $boardsize; $i++) {
my $iA = ord('A') + $i - 1;
if ($iA >= ord('I')) { $iA++; }
my $bw = pval
($coord, "stone");
my $colorboard_imgsrc = createPngFile
($bw, $img_pix_size, "", "","","","", "");
$colorboard .= qq@
<TD
>@
.
qq@
<IMG border
=0 HEIGHT
=$img_pix_size WIDTH
=$img_pix_size @
.
qq@SRC="html/images/$colorboard_imgsrc"></A></TD
>\n@
;
$colorboard .= "</TR>\n";
#$colorboard .= colorboard_letter_row($boardsize);
$colorboard .= "\n</TABLE>\n";
unless ($sortby) { $sortby = "filepos"; }
# open (TF, "> html/$tstfile.tst/index.html")
# or print "couldn't open for output; $!\n", die;
<TITLE
>$tstfile regression results
- _VERSION_
</TITLE
>
<META NAME
="ROBOTS" CONTENT
="NOINDEX, NOFOLLOW">
print TF
"<H3>$tstfile regression results - _VERSION_</H3>\n";
print TF
qq@
<TABLE border
=1>
<TH
><A href
="$name?tstfile=$tstfile&sortby=filepos">line
</A></TH
>
<TH
><A href
="$name?tstfile=$tstfile&sortby=num">number
</A></TH
>
<TH
><A href
="$name?tstfile=$tstfile&sortby=result">result
</A></TH
>
<TH
><A href
="$name?tstfile=$tstfile&sortby=cputime">cputime
</A></TH
>
<TH
><A href
="$name?tstfile=$tstfile&sortby=owl_node">owl_node
</A></TH
>
<TH
><A href
="$name?tstfile=$tstfile&sortby=reading_node">reading_node
</A></TH
>
<TH
><A href
="$name?tstfile=$tstfile&sortby=msperowl">1000*time/owl_node</A
></TH
>
my @files = glob("html/$tstfile.tst/*.xml");
foreach my $curfile (@files) {
$curfile =~ s/html.$tstfile.tst.(.*xml)/$1/;
open(FILE
, "html/$tstfile.tst/$curfile");
if $content =~ m@
<GTP_ALL
>(.*?
)</GTP_ALL
>@s;
if $content =~ m@
<GTP_COMMAND
>(.*?
)</GTP_COMMAND
>@s;
if $content =~ m@
<GOPROB
.*?status
="(.*?)"@s;
if $content =~ m@
<GOPROB
.*?number
=(\d
*)@s;
if $content =~ m@
<GOPROB
.*?filepos
=(\d
*)@s;
if $content =~ m@
<CORRECT
>(.*?
)</CORRECT
>@s;
if $content =~ m@
<ANSWER
>(.*?
)</ANSWER
>@s;
if $content =~ m@
<TIME
.*?CPU
=((\d
|\
.)*)@s;
if $content =~ m@
<COUNTER
[^>]*owl_node
="?(\d+)@s;
if $content =~ m@<COUNTER[^>]*reading_node="?
(\d
+)@s;
reading_node
=> $reading_node,
msperowl
=> ($owl_node ?
1000*$cputime/ $owl_node : 0),
sub byfilepos
{ $files{$a}{"filepos"} <=> $files{$b}{"filepos"}; }
sub bynum
{ $files{$a}{"num"} <=> $files{$b}{"num"}; }
fptonum
($files{$a}{"result"}) <=> fptonum
($files{$b}{"result"})
$files{$b}{cputime
} <=> $files{$a}{cputime
}
$files{$b}{owl_node
} <=> $files{$a}{owl_node
}
$files{$b}{reading_node
} <=> $files{$a}{reading_node
}
$files{$b}{msperowl
} <=> $files{$a}{msperowl
}
return byfilepos
if /filepos/i;
return byresult
if /result/i;
return bycputime
if /cputime/i;
return byowl_node
if /owl_node/i || /owlnode/i;
return bymsperowl
if /msperowl/i;
return byreading_node
if /reading_node/i || /readingnode/i;
$files{$a}{$_} <=> $files{$b}{$_};
my %totals = (cputime
=>0, owl_node
=>0);
foreach my $curfile (sort {filesby
($sortby)} keys %files) {
my %h = %{$files{$curfile}};
my $numURL = qq@
<A href
="$name?$tstfile:$h{num}">$h{num
}</A
>@
;
$r =~ s@
^([A
-Z
]*)$@
<B
>$1</B
>@
;
print TF
"<TR><TD>$h{filepos}</TD><TD>$numURL</TD><TD>$r</TD><TD>$h{expected}</TD>"
. "<TD>$h{got}</TD><TD>$h{gtp}</TD><TD>$h{cputime}</TD><TD>$h{owl_node}</TD>"
. "<TD>$h{reading_node}</TD>"
. "<TD>".sprintf("%.2f",$h{msperowl
})."</TD></TR>\n";
$totals{cputime
} += $h{cputime
};
$totals{owl_node
} += $h{owl_node
};
$totals{reading_node
} += $h{reading_node
};
print TF
"<TR><TD>Total</TD><TD> </TD><TD> </TD><TD> </TD>"
. "<TD> </TD><TD> </TD><TD>$totals{cputime}</TD><TD>$totals{owl_node}</TD>"
. "<TD>$totals{reading_node}</TD>"
." <TD>".sprintf("%.2f",1000*$totals{cputime
}/($totals{owl_node}+.0001))."</TD
></TR
>\n";
my ($coord, $attrib) = @_;
# print "$coord $attrib<BR
>\n";
if ($points{$coord} =~ m@$attrib="(.*?
)"@) {
# if ($attrib eq 'stone') {
# print "$attrib=$1<BR
>\n";
if $content =~ m@<GOPROB.*?number=(\d*)@s;
if $content =~ m@<GOPROB.*?file="(.*?
)"@s;
if $content =~ m@<GOPROB.*?status="(.*?
)"@s;
if $content =~ m@<CORRECT>(.*?)</CORRECT>@s;
if $content =~ m@<ANSWER>(.*?)</ANSWER>@s;
if $content =~ m@<GTP_ALL>(.*?)</GTP_ALL>@s;
$attribs{"description
"} = $1
if $content =~ m@<DESCRIPTION>(.*?)</DESCRIPTION>@s;
$attribs{"category
"} = $1
if $content =~ m@<CATEGORY>(.*?)</CATEGORY>@s;
$attribs{"severity
"} = $1
if $content =~ m@<SEVERITY>(.*?)</SEVERITY>@s;
$attribs{"gtp_command
"} = $1
if $content =~ m@<GTP_COMMAND>(.*?)</GTP_COMMAND>@s;
if $content =~ m@<TIME.*?CPU=((\d|\.)*)@s;
$attribs{"boardsize
"} = $1
if $content =~ m@<BOARD[^>]*size=(\d+)@s;
$attribs{$_."_counter
"} = $1
if $content =~ m@<COUNTER[^>]*$_="?
(\d
+)@s;
return \
%attribs unless $details;
$content =~ s@
.*?
<POINT@
<POINT
@s;
while ($content =~ s@
<POINT
(.*?
)></POINT
>@
@s) {
if ($pattr =~ m
@coord="(.*?)"@s) {
print "<P>MISSING coord: " . encode
($content) . "<P>" .
sub colorboard_letter_row
{
my $ret = " <TR>\n <TD> </TD>\n";
for (my $i = 1; $i <= $boardsize; $i++) {
my $iA = ord('A') + $i - 1;
if ($iA >= ord('I')) { $iA++; }
$ret .= " <TD align=center valign=center>$iA</TD>\n";
$ret .= " <TD> </TD>\n </TR>";
my $boardsize = $attribs{"boardsize"}; #need to add to export.
$ret .= "(;\nFF[4]GM[1]SZ[$boardsize]\nAP[regress.plx]\n";
for (my $j = $boardsize; $j > 0; $j--) {
for (my $i = 1; $i <= $boardsize; $i++) {
my $iA = ord('A') + $i - 1;
if ($iA >= ord('I')) { $iA++; }
my $bw = pval
($coord, "stone");
$ret .= "AB\[" . GTPtoSGF
($coord, $boardsize) . "]";
} elsif ($bw eq "white") {
$ret .= "AW\[" . GTPtoSGF
($coord, $boardsize) . "]";
$ret =~ s/((A[BW]\[..\]){12})/$1\n/g;
if (! /([A-Z])([0-9]{1,2})/) {
$_ = ord($1) - ord("A") + 1;
if ($_ > (ord("I") - ord("A") + 1)) { $_--; }
chr(ord("a") + $_ - 1) . chr(ord("a") + $boardsize - $2);
do "html/one.perldata.new" or confess
"can't do perldata";
$h{$b}->{cputime
} <=> $h{$a}->{cputime
}
<TITLE
>Slow results
- GNU Go
</TITLE
>
<META NAME
="ROBOTS" CONTENT
="NOINDEX, NOFOLLOW">
print "<BODY><H4>Slow results</H4>";
print "<TABLE border=1>";
print "<TR><TD><B>Problem</B></TD><TD><B>Status</B></TD><TD>CPU Time</TD></TR>\n";
foreach my $k (sort $by_cputime keys %h) {
print qq@
<TR
><TD
><A href
="$name?$k">$k</TD><TD>$h{$k}->{status}</TD
>@
;
print qq@
<TD
>$h{$k}->{cputime
}</TD></TR
>@
;
my ($p, $n) = $k =~ /(\w+):(\d+)/;
open (F
, "html/$p.tst/$n.trace") or do {print "Missing trace file for $k<BR>"; next;};
if ($line =~ /^owl_.*\d{6} nodes/) {
print qq@
<TR
><TD
> 
;</TD><TD> </TD
><TD
>@
if $first-- > 0;
print qq@
</TD></TR
>@
if $first < 1;
print "</TABLE></BODY></HTML>\n";
do "html/one.perldata.new" or confess
"can't do perldata";
<HEAD
><TITLE
>Special results
- GNU Go
</TITLE
>
<META NAME
="ROBOTS" CONTENT
="NOINDEX, NOFOLLOW">
print "<BODY><H4>Special results</H4>";
print "<TABLE border=1>";
print "<TR><TD><B>Problem</B></TD><TD><B>Status</B></TD><TD>cputime</TD></TR>\n";
print qq@
<TR
><TD
><A href
="$name?$1">$1</A></TD
><TD
>$h{$1}->{status
}</TD
>@
.
qq@
<TD
>$h{$1}->{cputime
}</TD></TR
>\n@
;
print qq@
</TABLE></BODY
></HTML
>@
;
if (-e
'BREAKAGE.local') {
open (BF
, 'BREAKAGE.local');
if (my ($bfile, $bpf) = $_ =~ /^(\w+:\d+)\s+(FAILED|PASSED)/i) {
$breakage{lc $bfile} = $bpf;
do "html/one.perldata.new" or confess
"can't do perldata";
<TITLE
>Unexpected results
- GNU Go
</TITLE
>
<META NAME
="ROBOTS" CONTENT
="NOINDEX, NOFOLLOW">
print "<BODY><H4>Unexpected results</H4>";
my ($aname, $anumber) = $a =~ /(.*):(.*)/;
my ($bname, $bnumber) = $b =~ /(.*):(.*)/;
foreach my $k (sort bynamenumber
keys %h) {
my $status = %{$h{$k}}->{status
};
defined $status or do { warn "missing status for $k"; next;};
if ($status eq 'FAILED') {
unless (defined ($breakage{lc $k}) and $breakage{lc $k}eq 'FAILED') {
} elsif ($status eq 'PASSED') {
unless (defined ($breakage{lc $k}) and $breakage{lc $k} eq 'PASSED') {
} elsif ($status eq 'passed') {
if (defined ($breakage{lc $k})) {
} elsif ($status eq 'failed') {
if (defined ($breakage{lc $k})) {
print "<TABLE border=1>\n";
print qq@
<TR
><TD
>FAILS
</TD><TD>@.scalar(@ufails).qq@</TD
></TR
>\n@
;
print qq@
<TR
><TD
>fails
</TD><TD>@.scalar(@fails).qq@</TD
></TR
>\n@
;
print qq@
<TR
><TD
>PASSES
</TD><TD>@.scalar(@upasses).qq@</TD
></TR
>\n@
;
print qq@
<TR
><TD
>passes
</TD><TD>@.scalar(@passes).qq@</TD
></TR
>\n@
;
print qq@
<TR
><TD
>pass
: fail
</TD
><TD
>@
.
sprintf("%.2f : 1", ((@upasses + @passes) / (@ufails + @fails + .001))).
print "<TABLE border=1>";
print "<TR><TD><B>Problem</B></TD><TD><B>Status</B></TD></TR>\n";
print qq@
<TR
><TD
><A href
="$name?$_">$_</A></TD
><TD
>FAILED
</TD></TR
>\n@
;
print qq@
<TR
><TD
><A href
="$name?$_">$_</A></TD
><TD
>failed
</TD></TR
>\n@
;
print qq@
<TR
><TD
><A href
="$name?$_">$_</A></TD
><TD
>PASSED
</TD></TR
>\n@
;
print qq@
<TR
><TD
><A href
="$name?$_">$_</A></TD
><TD
>passed
</TD></TR
>\n@
;
print "</body></html>\n";
do "html/one.perldata.new" or confess
"can't do perldata";
my %hash = %{$VAR1->[0]};
foreach my $k (keys %hash) {
my $status = $hash{$k}{status
};
$fails{$k} = $hash{$k} if $status =~ /failed/i;
my $ca = $fails{$a}{category
};
my $cb = $fails{$b}{category
};
if ($ca ne "" and $cb eq "") { return -1; }
if ($ca eq "" and $cb ne "") { return 1; }
$ca ne "" or $ca = $fails{$a}{file
};
$cb ne "" or $cb = $fails{$b}{file
};
my $sa = $fails{$a}{severity
};
my $sb = $fails{$b}{severity
};
#print '$sa <=> $sb :' . "$sa <=> $sb ($ca, $cb)" , "\n"
# if defined $sa and defined $sb and ($sa ne "") and ($sb ne "");
if ($sa eq "") {$sa = 5};
if ($sb eq "") {$sb = 5};
my $fa = $fails{$a}{file
};
my $fb = $fails{$b}{file
};
my $na = $fails{$a}{num
};
my $nb = $fails{$b}{num
};
$h{category
} or $h{file
};
defined $s or do {return 5};
$s ne "" or do {return 5};
<TITLE
>Failures by category
- GNU Go
</TITLE
>
<META NAME
="ROBOTS" CONTENT
="NOINDEX, NOFOLLOW">
print "<BODY><H4>Failures by category</H4>";
print qq@
<A href
="$name?">main
index</A
>@
;
print "<TABLE border=1>";
print "<TR><TD><B>Category</B></TD><TD><B>Severity</B></TD><TD><B>Problem</B></TD>\n";
foreach my $k (sort $by_cat keys %fails) {
if (uc(getcat
($fails{$k})) ne $cat) {
$cat = uc(getcat
($fails{$k}));
print "<TR><TD>$cat</TD>\n";
if (($sev eq "") or $sev != getsev
($fails{$k})) {
print "</TD></TR>\n<TR><TD> </TD>" if ($sev ne "");
$sev = getsev
($fails{$k});
print "<TD>$sev</TD><TD>\n";
print qq@
<A href
="$name?$k">$k</A>  </A
>\n@
;
print "</body></html>\n";