| 1 | #! /usr/bin/perl -w |
| 2 | |
| 3 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # |
| 4 | # This program is distributed with GNU Go, a Go program. # |
| 5 | # # |
| 6 | # Write gnugo@gnu.org or see http://www.gnu.org/software/gnugo/ # |
| 7 | # for more information. # |
| 8 | # # |
| 9 | # Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 # |
| 10 | # 2008 and 2009 by the Free Software Foundation. # |
| 11 | # # |
| 12 | # This program is free software; you can redistribute it and/or # |
| 13 | # modify it under the terms of the GNU General Public License # |
| 14 | # as published by the Free Software Foundation - version 3, # |
| 15 | # or (at your option) any later version. # |
| 16 | # # |
| 17 | # This program is distributed in the hope that it will be # |
| 18 | # useful, but WITHOUT ANY WARRANTY; without even the implied # |
| 19 | # warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR # |
| 20 | # PURPOSE. See the GNU General Public License in file COPYING # |
| 21 | # for more details. # |
| 22 | # # |
| 23 | # You should have received a copy of the GNU General Public # |
| 24 | # License along with this program; if not, write to the Free # |
| 25 | # Software Foundation, Inc., 51 Franklin Street, Fifth Floor, # |
| 26 | # Boston, MA 02111, USA. # |
| 27 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # |
| 28 | # |
| 29 | # matcher_check info: |
| 30 | # |
| 31 | # Plays one gtp program against itself or lets it analzye a saved .sgf-file, |
| 32 | # and watches for bad status transitions. |
| 33 | # |
| 34 | # FIXME: if the vertex by which a dragon is named ever changes, |
| 35 | # the hash table used will consider it new. therefore, if the |
| 36 | # vertex changes at the same time an illegal state change occurs, |
| 37 | # it will get missed. Also, it is possible that a dragon would |
| 38 | # be captured, and that vertex go unused until a new piece was |
| 39 | # played in that spot, resulting in a false positive. However, |
| 40 | # this should be rare (?). |
| 41 | |
| 42 | package TWOGTP_A; |
| 43 | |
| 44 | use IPC::Open2; |
| 45 | use Getopt::Long; |
| 46 | use FileHandle; |
| 47 | use strict; |
| 48 | use warnings; |
| 49 | use Carp; |
| 50 | |
| 51 | STDOUT->autoflush(1); |
| 52 | |
| 53 | #following added globally to allow "use strict" : |
| 54 | my $vertex; |
| 55 | my $first; |
| 56 | my $sgfmove; |
| 57 | my $sgffilename; |
| 58 | my $pidp; |
| 59 | my $sgffile; |
| 60 | my $handicap_stones; |
| 61 | my $result; |
| 62 | my @vertices; |
| 63 | my $second; |
| 64 | my %game_list; |
| 65 | #end of "use strict" repairs |
| 66 | |
| 67 | my $program; |
| 68 | my $size = 19; |
| 69 | my $verbose = 0; |
| 70 | my $komi = 5.5; |
| 71 | my $handicap = 0; |
| 72 | my $games = 1; |
| 73 | my $wanthelp; |
| 74 | |
| 75 | #added for matcher_check |
| 76 | my %match_hist; |
| 77 | my $loadfile; |
| 78 | my $movenum; |
| 79 | my $movecount; |
| 80 | my $move; |
| 81 | my $toplay; |
| 82 | my $randseed; |
| 83 | my $stable; |
| 84 | my $pids; |
| 85 | my $stable_move = ""; |
| 86 | my $noilcheck; |
| 87 | my $color; |
| 88 | |
| 89 | my $helpstring = " |
| 90 | |
| 91 | Run with: |
| 92 | |
| 93 | matchercheck --program \'<path to program> --mode gtp [program options]\' \\ |
| 94 | [matcher_check options] |
| 95 | |
| 96 | Possible matcher_check options: |
| 97 | |
| 98 | --verbose 1 (to list moves) or --verbose 2 (to draw board) |
| 99 | --komi <amount> |
| 100 | --handicap <amount> |
| 101 | --size <board size> (default 19) |
| 102 | --games <number of games to play> (-1 to play forever) |
| 103 | --sgffile <filename> (file to save games as) |
| 104 | --loadsgf <filename> (file to analyze) |
| 105 | --movecount <number of moves to check> |
| 106 | --randseed <number> (sets the random seed) |
| 107 | --stable \'<path to stable version> --mode gtp [program options]\' |
| 108 | --noilcheck (turns off illegal transition checks) |
| 109 | --color <color> (only replay for color; has no effect |
| 110 | without --noilcheck and --loadsgf) |
| 111 | --help (show this) |
| 112 | |
| 113 | |
| 114 | "; |
| 115 | |
| 116 | GetOptions( |
| 117 | "program|p=s" => \$program, |
| 118 | "verbose|v=i" => \$verbose, |
| 119 | "komi|k=f" => \$komi, |
| 120 | "handicap|h=i" => \$handicap, |
| 121 | "size|boardsize|s=i" => \$size, |
| 122 | "sgffile|o=s" => \$sgffilename, |
| 123 | "loadsgf|l=s" => \$loadfile, |
| 124 | "games=i" => \$games, |
| 125 | "movecount=i" => \$movecount, |
| 126 | "randseed=i" => \$randseed, |
| 127 | "stable=s" => \$stable, |
| 128 | "noilcheck" => \$noilcheck, |
| 129 | "color=s" => \$color, |
| 130 | "help" => \$wanthelp, |
| 131 | ); |
| 132 | |
| 133 | if ($wanthelp) { |
| 134 | print $helpstring; |
| 135 | exit; |
| 136 | } |
| 137 | |
| 138 | |
| 139 | if (!$program) { |
| 140 | $program = '../gnugo --mode gtp --quiet'; |
| 141 | warn "Defaulting program to: $program\n"; |
| 142 | } |
| 143 | |
| 144 | if (defined($color) and (!defined($noilcheck) or !defined($loadfile))) { |
| 145 | print "Error: --color requires --noilcheck and --loadsgf"; |
| 146 | exit; |
| 147 | } |
| 148 | |
| 149 | |
| 150 | # create FileHandles |
| 151 | my $prog_in = new FileHandle; # stdin of program |
| 152 | my $prog_out = new FileHandle; # stdout of program |
| 153 | my $stable_in = new FileHandle; # stdin of stable version |
| 154 | my $stable_out = new FileHandle; # stdout of stable version |
| 155 | |
| 156 | |
| 157 | if ($loadfile) |
| 158 | { |
| 159 | #we need to analyze an sgf file |
| 160 | if (not defined $movecount) { |
| 161 | print "Error: When analyzing an sgf file with --loadsgf <filename>, you also need to |
| 162 | specify the number of moves to check with --movecount <n>. |
| 163 | "; |
| 164 | exit; |
| 165 | } |
| 166 | |
| 167 | $pidp = open2($prog_out, $prog_in, $program); |
| 168 | $pids = open2($stable_out, $stable_in, $stable) if defined($stable); |
| 169 | print "program pid: $pidp\n" if $verbose; |
| 170 | print "stable pid: $pids\n" if (defined($stable) and $verbose); |
| 171 | |
| 172 | if (defined($randseed)) { |
| 173 | print $prog_in "set_random_seed $randseed\n"; |
| 174 | eat_no_response($prog_out); |
| 175 | } else { |
| 176 | print $prog_in "get_random_seed\n"; |
| 177 | $randseed = eat_one_line($prog_out); |
| 178 | print "random seed $randseed\n"; |
| 179 | } |
| 180 | |
| 181 | if (defined($stable)) { |
| 182 | $randseed =~ s/^= //smg; |
| 183 | print $stable_in "set_random_seed $randseed\n"; |
| 184 | eat_no_response($stable_out); |
| 185 | } |
| 186 | |
| 187 | for ($movenum = 1; $movenum <= $movecount + 1; $movenum++) |
| 188 | { |
| 189 | #load the file, check the statuses, next move. |
| 190 | my $lmove = $movenum + 1;#number to load up to |
| 191 | print "loading move $movenum\n" if $verbose; |
| 192 | print $prog_in "loadsgf $loadfile $lmove\n"; |
| 193 | eat_no_response($prog_out); |
| 194 | if (!defined($noilcheck)) { |
| 195 | check_matcher($prog_in, $prog_out); |
| 196 | print "done checking status.\n" if ($verbose); |
| 197 | } |
| 198 | |
| 199 | #do stable checks |
| 200 | if (defined($stable)) { |
| 201 | print $stable_in "loadsgf $loadfile $lmove\n"; |
| 202 | $toplay = eat_one_line($stable_out); |
| 203 | $toplay =~ s/^=//smg; |
| 204 | $toplay =~ s/ //smg; |
| 205 | if (!defined($color) or ($color eq $toplay)) { |
| 206 | print $prog_in "genmove_$toplay\n"; |
| 207 | print $stable_in "genmove_$toplay\n"; |
| 208 | $move = eat_move($prog_out); |
| 209 | $stable_move = eat_move($stable_out); |
| 210 | if ($move ne $stable_move and defined ($stable)) { |
| 211 | print "At move $movenum, $toplay\:\n"; |
| 212 | print "Test version played $move\n"; |
| 213 | print "Stable version played $stable_move\n"; |
| 214 | if ($verbose eq 2) { |
| 215 | print $prog_in "showboard\n"; |
| 216 | print eat_response($prog_out); |
| 217 | } |
| 218 | } else { |
| 219 | print "$toplay plays $move\n" if $verbose; |
| 220 | } |
| 221 | } |
| 222 | } |
| 223 | } |
| 224 | |
| 225 | print "done reading sgf file\n" if ($verbose); |
| 226 | exit; |
| 227 | } |
| 228 | |
| 229 | |
| 230 | while ($games > 0) { |
| 231 | %match_hist = (); |
| 232 | $pidp = open2($prog_out, $prog_in, $program); |
| 233 | print "program pid: $pidp\n" if $verbose; |
| 234 | |
| 235 | if (defined($stable)) { |
| 236 | $pids = open2($stable_out, $stable_in, $stable); |
| 237 | print "stable pid: $pids\n" if $verbose; |
| 238 | } |
| 239 | |
| 240 | $sgffile = rename_sgffile($games, $sgffilename) if defined $sgffilename; |
| 241 | |
| 242 | if ((defined $sgffilename) && !open(SGFFILEHANDLE, ">$sgffile")) { |
| 243 | printf("can't open $sgffile\n"); |
| 244 | undef($sgffilename); |
| 245 | } |
| 246 | |
| 247 | #set autoflushing for sgf file |
| 248 | SGFFILEHANDLE->autoflush(1); |
| 249 | |
| 250 | if (!defined $komi) { |
| 251 | if ($handicap > 0) { |
| 252 | $komi = 0.5; |
| 253 | } |
| 254 | else { |
| 255 | $komi = 5.5; |
| 256 | } |
| 257 | } |
| 258 | |
| 259 | print $prog_in "boardsize $size\n"; |
| 260 | eat_no_response($prog_out); |
| 261 | print $prog_in "komi $komi\n"; |
| 262 | eat_no_response($prog_out); |
| 263 | |
| 264 | if (defined($stable)) { |
| 265 | print $stable_in "komi $komi\n"; |
| 266 | eat_no_response($stable_out); |
| 267 | print $stable_in "boardsize $size\n"; |
| 268 | eat_no_response($stable_out); |
| 269 | } |
| 270 | |
| 271 | if (defined($randseed)) { |
| 272 | print $prog_in "set_random_seed $randseed\n"; |
| 273 | eat_no_response($prog_out); |
| 274 | } else { |
| 275 | print $prog_in "get_random_seed\n"; |
| 276 | $randseed = eat_one_line($prog_out); |
| 277 | $randseed =~ s/^= //smg; |
| 278 | print "random seed $randseed\n"; |
| 279 | } |
| 280 | |
| 281 | if (defined($stable)) { |
| 282 | print $stable_in "set_random_seed $randseed\n"; |
| 283 | eat_no_response($stable_out); |
| 284 | } |
| 285 | |
| 286 | undef $randseed; #if more than one game, get a new seed next time. |
| 287 | |
| 288 | print SGFFILEHANDLE "(;GM[1]FF[4]RU[Japanese]SZ[$size]HA[$handicap]KM[$komi]" |
| 289 | if defined $sgffilename; |
| 290 | |
| 291 | my $pass = 0; |
| 292 | $move = ""; |
| 293 | |
| 294 | if ($handicap < 2) { |
| 295 | $toplay = "black"; |
| 296 | } |
| 297 | else { |
| 298 | $toplay = "white"; |
| 299 | print $prog_in "fixed_handicap $handicap\n"; |
| 300 | |
| 301 | $handicap_stones = eat_handicap($prog_out); |
| 302 | my $stable_stones = $handicap_stones; |
| 303 | |
| 304 | if (defined($stable)) { |
| 305 | print $stable_in "fixed_handicap $handicap\n"; |
| 306 | $stable_stones = eat_handicap($stable_out); |
| 307 | } |
| 308 | |
| 309 | if ($stable_stones ne $handicap_stones) { |
| 310 | print "Handicap discrepancy:\n"; |
| 311 | print "Test: $handicap_stones\n"; |
| 312 | print "Stable: $stable_stones\n"; |
| 313 | } |
| 314 | |
| 315 | if (defined $sgffilename) { |
| 316 | print SGFFILEHANDLE $handicap_stones; |
| 317 | } |
| 318 | } |
| 319 | |
| 320 | $movenum = 1; |
| 321 | while ($pass < 2) { |
| 322 | print $prog_in "genmove_$toplay\n"; |
| 323 | $move = eat_move($prog_out); |
| 324 | |
| 325 | if (defined($stable)) { |
| 326 | print $stable_in "genmove_$toplay\n" if defined($stable); |
| 327 | $stable_move = eat_move($stable_out); |
| 328 | print $stable_in "undo\n"; |
| 329 | eat_no_response($stable_out); |
| 330 | } |
| 331 | |
| 332 | if ($move ne $stable_move and defined ($stable)) { |
| 333 | print "At move $movenum, $toplay\:\n"; |
| 334 | print "Test version played $move\n"; |
| 335 | print "Stable version played $stable_move\n"; |
| 336 | if ($verbose eq 2) { |
| 337 | print $prog_in "showboard\n"; |
| 338 | print eat_response($prog_out); |
| 339 | } |
| 340 | } else { |
| 341 | print "$toplay plays $move\n" if $verbose; |
| 342 | } |
| 343 | |
| 344 | $sgfmove = standard_to_sgf($move); |
| 345 | my $tpc = "B"; #toplay char |
| 346 | $tpc = "W" if ($toplay eq "white"); |
| 347 | print SGFFILEHANDLE ";$tpc\[$sgfmove\]\n" if defined $sgffilename; |
| 348 | |
| 349 | print $stable_in "$toplay $move\n" if defined($stable); |
| 350 | eat_no_response($stable_out) if defined($stable); |
| 351 | |
| 352 | if ($toplay eq "black") { |
| 353 | $toplay = "white"; |
| 354 | } else { |
| 355 | $toplay = "black"; |
| 356 | } |
| 357 | |
| 358 | if ($move =~ /PASS/i) { |
| 359 | $pass++; |
| 360 | } else { |
| 361 | $pass = 0; |
| 362 | } |
| 363 | |
| 364 | if ($verbose > 2) { |
| 365 | print $prog_in "showboard\n"; |
| 366 | eat_no_response($prog_out); |
| 367 | if (defined($stable)) { |
| 368 | print $stable_in "showboard\n"; |
| 369 | eat_no_response($stable_out); |
| 370 | } |
| 371 | } |
| 372 | |
| 373 | check_matcher($prog_in, $prog_out) if !defined($noilcheck); |
| 374 | $movenum++; |
| 375 | } |
| 376 | print $prog_in "estimate_score\n"; |
| 377 | $result = eat_score($prog_out); |
| 378 | if (defined($stable)) { |
| 379 | print $stable_in "estimate_score\n"; |
| 380 | my $stable_result = eat_score($stable_out); |
| 381 | print "scoring discrepancy. Stable score: $stable_result.\n" if ($stable_result ne $result); |
| 382 | } |
| 383 | |
| 384 | print "Result: $result\n"; |
| 385 | print $prog_in "quit\n"; |
| 386 | print $stable_in "quit\n" if defined($stable); |
| 387 | |
| 388 | if (defined $sgffilename) { |
| 389 | print "sgf file: $sgffile\n"; |
| 390 | print SGFFILEHANDLE ")"; |
| 391 | close SGFFILEHANDLE; |
| 392 | $game_list{$sgffile} = $result; |
| 393 | } |
| 394 | $games-- if $games > 0; |
| 395 | |
| 396 | #make sure gnugo dies correctly. |
| 397 | close $prog_in; |
| 398 | close $prog_out; |
| 399 | close $stable_in if defined($stable); |
| 400 | close $stable_out if defined($stable); |
| 401 | waitpid $pidp, 0; |
| 402 | waitpid $pids, 0; |
| 403 | |
| 404 | print "games remaining: $games\n"; |
| 405 | } |
| 406 | |
| 407 | if (defined $sgffilename) { |
| 408 | my $index_out = new FileHandle; |
| 409 | open ($index_out, "> " . index_name($sgffilename)); |
| 410 | print $index_out |
| 411 | "<HTML><HEAD><TITLE>game results</TITLE></HEAD> |
| 412 | <BODY><H3>Game Results</H3> |
| 413 | <H4>White: ".html_encode($program)."</H4> |
| 414 | <H4>Black: ".html_encode($program)."</H4> |
| 415 | <TABLE border=1> |
| 416 | <TR> |
| 417 | <TD>SGF file</TD> |
| 418 | <TD>Result</TD> |
| 419 | </TR> |
| 420 | "; |
| 421 | foreach (sort by_result keys(%game_list)) { |
| 422 | print $index_out "<TR><TD><A href=\"$_\">$_</A></TD>" . |
| 423 | "<TD>".html_encode(game_result($_))."</TD></TR>\n"; |
| 424 | } |
| 425 | print $index_out "</TABLE></BODY></HTML>\n"; |
| 426 | } |
| 427 | |
| 428 | exit; |
| 429 | #all done here. |
| 430 | |
| 431 | sub game_result { |
| 432 | $_ = shift; |
| 433 | $_ = $game_list{$_}; |
| 434 | #i.e.: B+13.5 (upper bound: -13.5, lower: -13.5)|B+13.5 (upper bound: -13.5, lower: -13.5) |
| 435 | #Make sure that all 4 values are the same. I've not seen them different yet. |
| 436 | #If they are ever different, need to improve the HTML output (now just -999) - |
| 437 | # an explanation of the score mismatch problem would be appropriate. |
| 438 | $_ =~ /^.*upper bound..([0-9+.\-]*)..lower..\1.\|.*upper bound..\1..lower..\1./; |
| 439 | if (defined($1)) { |
| 440 | return $1; |
| 441 | } else { |
| 442 | return -999; |
| 443 | } |
| 444 | } |
| 445 | |
| 446 | sub by_result { |
| 447 | game_result($a) <=> game_result($b) || $a cmp $b; |
| 448 | } |
| 449 | |
| 450 | sub html_encode { |
| 451 | #print shift; |
| 452 | my $r = shift; |
| 453 | $r =~ s/&/&/g; |
| 454 | $r =~ s/</</g; |
| 455 | $r =~ s/>/>/g; |
| 456 | return $r; |
| 457 | } |
| 458 | |
| 459 | sub eat_no_response { |
| 460 | my $h = shift; |
| 461 | |
| 462 | # ignore empty lines |
| 463 | my $line = ""; |
| 464 | while ($line eq "") { |
| 465 | chop($line = <$h>) or die "No response!"; |
| 466 | $line =~ s/(\s|\n)*$//smg; |
| 467 | } |
| 468 | } |
| 469 | |
| 470 | sub eat_response { |
| 471 | my $h = shift; |
| 472 | my $response = ""; |
| 473 | # ignore empty lines |
| 474 | my $line = ""; |
| 475 | while ($line eq "") { |
| 476 | chop($line = <$h>) or die "No response!"; |
| 477 | $line =~ s/(\s|\n)*$//smg; |
| 478 | } |
| 479 | while ($line ne "") { |
| 480 | $response = "$response$line\n"; |
| 481 | chop($line = <$h>) or die "No response!"; |
| 482 | $line =~ s/(\s|\n)*$//smg; |
| 483 | } |
| 484 | return $response; |
| 485 | } |
| 486 | |
| 487 | sub eat_one_line { |
| 488 | my $h = shift; |
| 489 | # ignore empty lines |
| 490 | my $line = ""; |
| 491 | while ($line eq "") { |
| 492 | chop($line = <$h>) or die "No response!"; |
| 493 | $line =~ s/(\s|\n)*$//smg; |
| 494 | } |
| 495 | return $line; |
| 496 | } |
| 497 | |
| 498 | sub eat_move { |
| 499 | my $h = shift; |
| 500 | # ignore empty lines |
| 501 | my $line = ""; |
| 502 | while ($line eq "") { |
| 503 | if (!defined($line = <$h>)) { |
| 504 | print SGFFILEHANDLE ")"; |
| 505 | close SGFFILEHANDLE; |
| 506 | die "Engine crashed!\n"; |
| 507 | } |
| 508 | $line =~ s/(\s|\n)*$//smg; |
| 509 | } |
| 510 | my ($equals, $move) = split(' ', $line, 2); |
| 511 | $line = <$h>; |
| 512 | defined($move) or confess "no move found: line was: '$line'"; |
| 513 | return $move; |
| 514 | } |
| 515 | |
| 516 | sub eat_handicap { |
| 517 | my $h = shift; |
| 518 | my $sgf_handicap = "AB"; |
| 519 | # ignore empty lines, die if process is gone |
| 520 | my $line = ""; |
| 521 | while ($line eq "") { |
| 522 | chop($line = <$h>) or die "No response!"; |
| 523 | } |
| 524 | @vertices = split(" ", $line); |
| 525 | foreach $vertex (@vertices) { |
| 526 | if (!($vertex eq "=")) { |
| 527 | $vertex = standard_to_sgf($vertex); |
| 528 | $sgf_handicap = "$sgf_handicap\[$vertex\]"; |
| 529 | } |
| 530 | } |
| 531 | return "$sgf_handicap;"; |
| 532 | } |
| 533 | |
| 534 | sub eat_score { |
| 535 | my $h = shift; |
| 536 | # ignore empty lines, die if process is gone |
| 537 | my $line = ""; |
| 538 | while ($line eq "") { |
| 539 | chop($line = <$h>) or die "No response!"; |
| 540 | $line =~ s/^\s*//msg; |
| 541 | $line =~ s/\s*$//msg; |
| 542 | } |
| 543 | $line =~ s/\s*$//; |
| 544 | my ($equals, $result) = split(' ', $line, 2); |
| 545 | $line = <$h>; |
| 546 | return $result; |
| 547 | } |
| 548 | |
| 549 | sub standard_to_sgf { |
| 550 | for (@_) { confess "Yikes!" if !defined($_); } |
| 551 | for (@_) { tr/A-Z/a-z/ }; |
| 552 | $_ = shift(@_); |
| 553 | /([a-z])([0-9]+)/; |
| 554 | return "tt" if $_ eq "pass"; |
| 555 | |
| 556 | $first = ord $1; |
| 557 | if ($first > 104) { |
| 558 | $first = $first - 1; |
| 559 | } |
| 560 | $first = chr($first); |
| 561 | $second = chr($size+1-$2+96); |
| 562 | return "$first$second"; |
| 563 | } |
| 564 | |
| 565 | sub rename_sgffile { |
| 566 | my $nogames = int shift(@_); |
| 567 | $_ = shift(@_); |
| 568 | s/\.sgf$//; |
| 569 | # Annoying to loose _001 on game #1 in multi-game set. |
| 570 | # Could record as an additional parameter. |
| 571 | # return "$_.sgf" if ($nogames == 1); |
| 572 | return sprintf("$_" . "_%03d.sgf", $nogames); |
| 573 | } |
| 574 | |
| 575 | sub index_name { |
| 576 | $_ = shift; |
| 577 | s/\.sgf$//; |
| 578 | return $_ . "_index.html"; |
| 579 | } |
| 580 | |
| 581 | sub check_matcher { |
| 582 | #check for illegal transitions, and print things if they happen |
| 583 | my $in = shift; |
| 584 | my $out = shift; |
| 585 | my $line = ""; |
| 586 | my $legality = "illegal"; |
| 587 | my $vertex = " "; |
| 588 | my $new_status = " "; |
| 589 | my $old_status; |
| 590 | my $il_vertex = ""; |
| 591 | my $il_move = ""; |
| 592 | |
| 593 | #send command |
| 594 | print $in "dragon_status\n"; |
| 595 | |
| 596 | while ($line eq "") { |
| 597 | chop($line = <$out>); |
| 598 | $line =~ s/^\s*//smg; |
| 599 | $line =~ s/\s*$//smg; |
| 600 | } |
| 601 | |
| 602 | while ($line ne "") |
| 603 | { |
| 604 | print "parsing a line\n" if ($verbose); |
| 605 | $line =~ s/= //g; #zap the "= " at the front of the response |
| 606 | $line =~ s/\n//g; #zap newlines... |
| 607 | $line =~ s/://g; #zap the : |
| 608 | print $line . "\n" if ($verbose); |
| 609 | ($vertex, $new_status) = split(" ", $line); #and split on spaces |
| 610 | #extra get trashed |
| 611 | $old_status = $match_hist{$vertex} if (exists($match_hist{$vertex})); |
| 612 | |
| 613 | #debug output |
| 614 | if ($verbose > 1) |
| 615 | { |
| 616 | print "Vertex: $vertex\n"; |
| 617 | print "Old Status: $old_status\n" if (exists($match_hist{$vertex})); |
| 618 | print "New Status: $new_status\n"; |
| 619 | } |
| 620 | |
| 621 | #if it's new, we don't care |
| 622 | if (!exists($match_hist{$vertex})) { |
| 623 | print "$vertex is new.\n" if ($verbose > 0); |
| 624 | $match_hist{$vertex} = $new_status; |
| 625 | next; |
| 626 | } |
| 627 | |
| 628 | #ok, so it's old |
| 629 | |
| 630 | $legality = "illegal"; |
| 631 | if ($old_status eq "critical") {$legality = "legal"}; |
| 632 | if ($new_status eq "critical") {$legality = "legal"}; |
| 633 | if ($new_status eq "unknown") {$legality = "legal"}; |
| 634 | if ($old_status eq "unknown") { |
| 635 | if ($new_status eq "alive") {$legality = "legal";} |
| 636 | if ($new_status eq "critical") {$legality = "legal";} |
| 637 | } |
| 638 | if ($old_status eq "alive" and $new_status eq "dead") { |
| 639 | $legality = "killed"; |
| 640 | } |
| 641 | |
| 642 | if ($match_hist{$vertex} eq $new_status) |
| 643 | { |
| 644 | #state didn't change -- valid result |
| 645 | print "$vertex remained unchanged.\n" if ($verbose > 0); |
| 646 | } else |
| 647 | { |
| 648 | #state changed |
| 649 | if ($legality eq "legal") |
| 650 | { |
| 651 | #legal state change |
| 652 | if ($verbose > 1) |
| 653 | { |
| 654 | print "Legal state change:\n"; |
| 655 | print "Games remaining: $games\n"; |
| 656 | print "Move: $movenum\n"; |
| 657 | print "Vertex: $vertex\n"; |
| 658 | print "Old Status: $old_status\n"; |
| 659 | print "New Status: $new_status\n"; |
| 660 | print "\n"; |
| 661 | } |
| 662 | } else |
| 663 | { |
| 664 | #illegal state change -- alive to dead or vice versa |
| 665 | print "Illegal state change:\n"; |
| 666 | print "Games remaining: $games\n"; |
| 667 | print "Move: $movenum\n"; |
| 668 | print "Vertex: $vertex\n"; |
| 669 | print "Old Status: $old_status\n"; |
| 670 | print "New Status: $new_status\n"; |
| 671 | print "\n"; |
| 672 | |
| 673 | #now print gtp output |
| 674 | #FIXME: doesn't work with --loadsgf because we don't have |
| 675 | #the move list available (it's hidden by using GTP loadsgf). |
| 676 | #FIXME: currently, only produces GTP output for one transition |
| 677 | #per move. This is because we have to finish parsing the |
| 678 | #entire output of dragon_status before dealing with finding |
| 679 | #missed attacks. Using arrays instead would fix it. |
| 680 | if ($legality eq "killed" and !defined($loadfile)) { |
| 681 | #The type we deal with now. |
| 682 | #FIXME: check for defensive errors too. |
| 683 | $il_move = $move; |
| 684 | $il_vertex = $vertex; |
| 685 | } |
| 686 | } |
| 687 | $match_hist{$vertex} = $new_status; |
| 688 | } |
| 689 | } continue { |
| 690 | chop($line = <$out>); |
| 691 | } |
| 692 | |
| 693 | if ($il_move ne "") { |
| 694 | print "attempting gtp output.\n"; |
| 695 | #undo the move, check owl_does_attack |
| 696 | #and owl_attack, if they disagree, |
| 697 | #output a regression test. |
| 698 | print $in "undo\n"; |
| 699 | eat_no_response($out); |
| 700 | my $oa_result = ""; |
| 701 | my $oda_result = ""; |
| 702 | print $in "owl_attack $il_vertex\n"; |
| 703 | $oa_result = eat_one_line($out); |
| 704 | print "owl_attack $il_vertex\: $oa_result\n"; |
| 705 | print $in "owl_does_attack $il_move $il_vertex\n"; |
| 706 | $oda_result = eat_one_line($out); |
| 707 | print "owl_does_attack $il_move $il_vertex\: $oda_result\n"; |
| 708 | |
| 709 | #now try to do something with it |
| 710 | if ($oa_result eq "= 0" and $oda_result ne "= 0") { |
| 711 | print "found a missed attack.\n\n"; |
| 712 | print "loadsgf $sgffile $movenum\n"; |
| 713 | print "owl_attack $il_vertex\n"; |
| 714 | print "#$oa_result\n"; |
| 715 | print "#? [1 $move]*\n\n"; |
| 716 | } else { |
| 717 | print "no missed attack found.\n\n"; |
| 718 | } |
| 719 | |
| 720 | #cancel the undo |
| 721 | my $last_played = "black"; |
| 722 | if ($toplay eq "B") { $last_played = "white"; } |
| 723 | print $in "genmove_$last_played\n"; |
| 724 | eat_move($out); |
| 725 | } |
| 726 | |
| 727 | print "\n" if ($verbose > 0); |
| 728 | } |
| 729 | |