view release on metacpan or  search on metacpan

t/05critter.t  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Exception;

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

use aliased 'AI::Evolve::Befunge::Blueprint' => 'Blueprint';
use aliased 'AI::Evolve::Befunge::Critter'   => 'Critter';
use AI::Evolve::Befunge::Util qw(v custom_config push_debug);

my $num_tests;
BEGIN { $num_tests = 0; };


# setup
my $ph = AI::Evolve::Befunge::Physics->new('test1');
my $bp = Blueprint->new(code => ' 'x256, dimensions => 4);
my $bp2 = Blueprint->new(code => " \n"x128, dimensions => 4);
my $config = custom_config();


# constructor
dies_ok(sub {Critter->new(Config => $config, Physics => $ph)}, "Critter->new dies without Blueprint");
like($@, qr/Usage: /, "died with usage message");
dies_ok(sub {Critter->new(Blueprint => $bp, Physics => $ph                    )}, "Critter->new dies without Config");
dies_ok(sub {Critter->new(Blueprint => $bp, Config => $config                )}, "Critter->new dies without Physics");
dies_ok(sub {Critter->new(Blueprint => $bp, Physics => 1,   Config => $config)}, "Critter->new dies with 0 non-ref Physics");
lives_ok(sub{Critter->new(Blueprint => $bp, Physics => $ph, Config => $config)}, "Critter->new lives ok with normal args");
my @common_args = (Blueprint => $bp, Physics => $ph, Config => $config);
dies_ok(sub {Critter->new(@common_args, Color       => undef)}, "Critter->new dies with undef Color");
dies_ok(sub {Critter->new(@common_args, Tokens      => 0)}, "Critter->new dies with 0 Tokens");
dies_ok(sub {Critter->new(@common_args, CodeCost    => 0)}, "Critter->new dies with 0 CodeCost");
dies_ok(sub {Critter->new(@common_args, IterCost    => 0)}, "Critter->new dies with 0 IterCost");
dies_ok(sub {Critter->new(@common_args, RepeatCost  => 0)}, "Critter->new dies with 0 RepeatCost");
dies_ok(sub {Critter->new(@common_args, StackCost   => 0)}, "Critter->new dies with 0 StackCost");
dies_ok(sub {Critter->new(@common_args, ThreadCost  => 0)}, "Critter->new dies with 0 ThreadCost");
dies_ok(sub {Critter->new(@common_args, Color       => 0)}, "Critter->new dies with 0 Color");
dies_ok(sub {Critter->new(Blueprint => $bp2,Physics => $ph, Config => $config)}, "Critter->new dies with newlines in code");
$bp2 = Blueprint->new(code => "00M", dimensions => 1);
lives_ok(sub{Critter->new(Blueprint => $bp2,Physics => $ph, Config => $config)}, "Critter->new handles unefunge");
my $critter = Critter->new(
    Blueprint => $bp,
    Physics   => $ph,
    Config    => $config,
    BoardSize => v(3, 3),
);
ok(ref($critter) eq "AI::Evolve::Befunge::Critter", "create a critter object");
is($critter->dims, 4, "codesize->dims > boardsize->dims, codesize->dims is used");
$critter = Critter->new(
    Blueprint => $bp2,
    Physics   => $ph,
    Config    => $config,
    BoardSize => v(3, 3),
    Commands  => { M => sub { AI::Evolve::Befunge::Physics::op_make_board_move(@_) } },
    IterPerTurn => 100,
);
is($critter->dims, 2, "codesize->dims < boardsize->dims, boardsize->dims is used");
BEGIN { $num_tests += 19 };


# invoke
my $board = AI::Evolve::Befunge::Board->new(Size => v(3, 3));
lives_ok(sub { $critter->invoke($board) }, "invoke runs with board");
lives_ok(sub { $critter->invoke()       }, "invoke runs without board");
$bp2 = Blueprint->new(code => "999**kq", dimensions => 1);
$critter = Critter->new(
    Blueprint => $bp2,
    Physics   => $ph,
    Config    => $config,