view release on metacpan or  search on metacpan

t/02physics.t  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;

BEGIN { $ENV{AIEVOLVEBEFUNGE} = 't/testconfig.conf'; };

my $num_tests;
BEGIN { $num_tests = 0; };
use Test::More;
use Test::Exception;
use Test::Output;

use aliased 'AI::Evolve::Befunge::Critter'   => 'Critter';
use aliased 'AI::Evolve::Befunge::Blueprint' => 'Blueprint';
use aliased 'AI::Evolve::Befunge::Board'     => 'Board';
use aliased 'AI::Evolve::Befunge::Physics'   => 'Physics';
use aliased 'AI::Evolve::Befunge::Critter::Result' => 'Result';
use AI::Evolve::Befunge::Util;


push_quiet(1);
# registration API
dies_ok(sub { register_physics(foo => 'bar') }, "no name");
lives_ok(sub{ register_physics(name => 'test0', foo => 'bar') }, "registration");
dies_ok(sub { register_physics(name => 'test0', foo => 'bar') }, "reregistration");
my $test = AI::Evolve::Befunge::Physics::find_physics("test0");
is($$test{foo}, 'bar', "our fake physics engine was registered properly");
$test = AI::Evolve::Befunge::Physics::find_physics("unknown");
is($$test{foo}, undef, "unknown engine results in undef");
BEGIN { $num_tests += 5 };


# constructor
dies_ok(sub { AI::Evolve::Befunge::Physics::new }, 'no package');
dies_ok(sub { Physics->new }, 'no plugin');
dies_ok(sub { Physics->new('unknown') }, 'nonexistent plugin');
my $config = custom_config();
$test = Physics->new('test1');
ok(ref($test) eq "AI::Evolve::Befunge::Physics::test1", "create a test physics object");
BEGIN { $num_tests += 4 };


# run_board_game
my $part1 =  "00M@" . (" "x12);
my $play1 =  "01M["
            ."M@#]" . (" "x8);
my $dier1 =  (" "x16);
my $tier1 =  "00M["
            ."M10]" . (" "x8);
my $tier2 =  "10M["
            ."M11]" . (" "x8);
my $bpart1 = Blueprint->new(code => $part1, dimensions => 2);
my $bplay1 = Blueprint->new(code => $play1, dimensions => 2);
my $bdier1 = Blueprint->new(code => $dier1, dimensions => 2);
my $btier1 = Blueprint->new(code => $tier1, dimensions => 2);
my $btier2 = Blueprint->new(code => $tier2, dimensions => 2);
my $board = Board->new(Size => 2, Dimensions => 2);
my $cpart1 = Critter->new(Blueprint => $bpart1, BoardSize => $board->size, Color => 1, Physics => $test, Commands => $$test{commands}, Config => $config);
my $cplay1 = Critter->new(Blueprint => $bplay1, BoardSize => $board->size, Color => 2, Physics => $test, Commands => $$test{commands}, Config => $config);
my $cdier1 = Critter->new(Blueprint => $bdier1, BoardSize => $board->size, Color => 1, Physics => $test, Commands => $$test{commands}, Config => $config);
my $ctier1 = Critter->new(Blueprint => $btier1, BoardSize => $board->size, Color => 1, Physics => $test, Commands => $$test{commands}, Config => $config);
my $ctier2 = Critter->new(Blueprint => $btier2, BoardSize => $board->size, Color => 2, Physics => $test, Commands => $$test{commands}, Config => $config);
dies_ok(sub { AI::Evolve::Befunge::Physics::run_board_game }, "no self");
dies_ok(sub { $test->run_board_game() }, "no board");
dies_ok(sub { $test->run_board_game([], $board) }, "no critters");
dies_ok(sub { $test->run_board_game([$cpart1], $board) }, "too few critters");
dies_ok(sub { $test->run_board_game([$cpart1, $cplay1, $cplay1], $board ) }, "too many critters");
dies_ok(sub { $test->run_board_game([$cpart1, $cplay1], $board, $cplay1 ) }, "too many args");
lives_ok(sub{ $test->run_board_game([$cpart1, $cplay1], $board ) }, "a proper game was played");
$$test{passable} = 0;
push_debug(1);