view release on metacpan or  search on metacpan

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

    Blueprint => $bp2,
    Physics   => $ph,
    Config    => $config,
    BoardSize => v(3, 3),
    Commands  => { M => sub { AI::Evolve::Befunge::Physics::op_make_board_move(@_) } },
    IterPerTurn => 100,
);
$rv = $critter->move();
ok($rv->died, "critter died");
like($rv->fate, qr/infinite loop/, "infinite loop is detected");

$critter = Critter->new(
    Blueprint => $bp,
    Physics   => $ph,
    Config    => $config,
    Commands  => AI::Evolve::Befunge::Physics::find_physics("test1")->{commands},
);
BEGIN { $num_tests += 6 };


# Critter's nerfed Language::Befunge interpreter
ok(exists($$critter{interp}{ops}{'+'}), "Language::Befunge loaded");
foreach my $op (',','.','&','~','i','o','=','(',')') {
    is($$critter{interp}{ops}{$op}, $$critter{interp}{ops}{r}, "operator $op got removed");
}
BEGIN { $num_tests += 10 };
foreach my $op ('+','-','1','2','3','<','>','[',']') {
    isnt($$critter{interp}{ops}{$op}, $$critter{interp}{ops}{r}, "operator $op wasn't removed");
}
BEGIN { $num_tests += 9 };


# Critter adds extra commands specified by physics engine
is($$critter{interp}{ops}{T},
    AI::Evolve::Befunge::Physics::find_physics("test1")->{commands}{T},
    "'Test' command added");
is  ($$critter{interp}{ops}{M}, $$critter{interp}{ops}{r}, "'Move' command not added");
BEGIN { $num_tests += 2 };


sub newaebc {
    my ($code, $fullsize, $nd, @extra) = @_;
    $code .= ' 'x($fullsize-length($code)) if length($code) < $fullsize;
    my $bp = Blueprint->new(code => $code, dimensions => $nd);
    push(@extra, BoardSize => $ph->board_size) if defined $ph->board_size;
    my $rv = Critter->new(Blueprint => $bp, Config => $config, Physics => $ph, 
        Commands  => AI::Evolve::Befunge::Physics::find_physics("test1")->{commands},
        @extra);
    return $rv;
}


# Critter adds lots of useful info to the initial IP's stack
my $stack_expectations =
    [ord('P'), # physics plugin
     2,        # dimensions
     1983,     # tokens
     2,        # itercost
     1,        # repeatcost
     2,        # stackcost
     10,       # threadcost
     17, 17,   # codesize
     17, 17,   # maxsize
     5, 5,     # boardsize,
     ];
$rv = newaebc('PPPPPPPPPPPPPPPPq', 17, 1);
is_deeply([reverse @{$rv->interp->get_params}], $stack_expectations, 'Critter constructor sets the params value correctly');
push(@$stack_expectations, 0, 0, 0); # make sure nothing else is on the stack
$rv = $rv->move();
ok(!$rv->died, "did not die");
is_deeply([@AI::Evolve::Befunge::Physics::test1::p], $stack_expectations, 'Critter adds lots of useful info to the initial stack');
@AI::Evolve::Befunge::Physics::test1::p = ();
$rv = newaebc('PPPPPPPPPPPPPPPPq', 17, 1)->move();
ok(!$rv->died, "did not die");
is_deeply([@AI::Evolve::Befunge::Physics::test1::p], $stack_expectations, 'Critter adds it EVERY time');
BEGIN { $num_tests += 5 };


$rv = newaebc("aq", 2, 1, Tokens => 60, StackCost => 40)->move();
is($rv->tokens, 14, 'spush decremented the proper amount');
ok(!$rv->died, "did not die");
$rv = newaebc("aq", 2, 1, Tokens => 30, StackCost => 40)->move();
is($rv->tokens, 24, 'spush bounced');
ok(!$rv->died, "did not die");
BEGIN { $num_tests += 4 };


$rv = newaebc("9{q", 3, 1, Tokens => 50, StackCost => 4)->move();
is($rv->tokens, 1, 'block_open decremented the proper amount');
ok(!$rv->died, "did not die");
$rv = newaebc("9{q", 3, 1, Tokens => 30, StackCost => 4)->move();
is($rv->tokens, 11, 'block_open bounced');
ok(!$rv->died, "did not die");
BEGIN { $num_tests += 4 };


$rv = newaebc("1jzq", 4, 1, Tokens => 250, RepeatCost => 200)->move();
is($rv->tokens, 38, '_op_flow_jump_to_wrap decremented the proper amount');
ok(!$rv->died, "did not die");
$rv = newaebc("1jzq", 4, 1, Tokens =>  50, RepeatCost => 200)->move();
is($rv->tokens, 34, '_op_flow_jump_to_wrap bounced');
ok(!$rv->died, "did not die");
BEGIN { $num_tests += 4 };


$rv = newaebc("ak1q", 4, 1, Tokens => 150, RepeatCost => 10)->move();
is($rv->tokens, 14, '_op_flow_repeat_wrap decremented the proper amount');
ok(!$rv->died, "did not die");
$rv = newaebc("ak1q", 4, 1, Tokens => 50, RepeatCost => 10)->move();
is($rv->tokens, 34, '_op_flow_repeat_wrap bounced');
ok(!$rv->died, "did not die");
BEGIN { $num_tests += 4 };


$rv = newaebc("tq", 2, 1, Tokens => 50, ThreadCost => 10);
$rv = $rv->move();
is($rv->tokens, 8, '_op_spawn_ip_wrap decremented the proper amount');
ok(!$rv->died, "did not die");
$rv = newaebc("tq", 2, 1, Tokens => 10, ThreadCost => 10)->move();
is($rv->tokens, 4, '_op_spawn_ip_wrap bounced');
ok(!$rv->died, "did not die");