view release on metacpan or  search on metacpan

lib/AI/Evolve/Befunge/Critter.pm  view on Meta::CPAN

                $offs *= $meas for (1..$dim-1);
                for(my $i = $offs; $i <= scalar @lines; $i += $offs) {
                    $lines[$i-1] .= $terms[$dim];
                }
            }
            $$self{code} = join("", @lines);
        }

        $interp->get_storage->store($$self{code}, $$self{codeoffset});
        # assign our corral size to the befunge space
        $interp->get_storage->expand($$self{minsize});
        $interp->get_storage->expand($$self{maxsize});
        # save off a copy of this befunge space for later reuse
        $$self{blueprint}{cache} = {} unless exists $$self{blueprint}{cache};
        $$self{blueprint}{cache}{$cachename} = $interp->get_storage->_copy;
    }
    my $storage = $interp->get_storage;
    $$storage{maxsize} = $$self{maxsize};
    $$storage{minsize} = $$self{minsize};
    # store a copy of the Critter in the storage, so _expand (below) can adjust
    # the remaining tokens.
    $$storage{_ai_critter} = $self;
    weaken($$storage{_ai_critter});
    # store a copy of the Critter in the interp, so various command callbacks
    # (below) can adjust the remaining tokens.
    $$interp{_ai_critter} = $self;
    weaken($$interp{_ai_critter});

    $interp->get_ops->{'{'} = \&AI::Evolve::Befunge::Critter::_block_open;
    $interp->get_ops->{'j'} = \&AI::Evolve::Befunge::Critter::_op_flow_jump_to_wrap;

lib/AI/Evolve/Befunge/Critter.pm  view on Meta::CPAN

    return 0 if $tokens < 0;
    $self->tokens($tokens);
    return 1;
}


# sandboxing stuff
{
    no warnings 'redefine';

    # override Storage->expand() to impose bounds checking
    my $_lbsgv_expand;
    BEGIN { $_lbsgv_expand = \&Language::Befunge::Storage::Generic::Vec::expand; };
    sub _expand {
        my ($storage, $v) = @_;
        if(exists($$storage{maxsize})) {
            my $min = $$storage{minsize};
            my $max = $$storage{maxsize};
            die "$v is out of bounds [$min,$max]!\n"
                unless $v->bounds_check($min, $max);
        }
        my $rv = &$_lbsgv_expand(@_);
        return $rv;
    }
    # redundant assignment avoids a "possible typo" warning
    *Language::Befunge::Storage::Generic::Vec::XS::expand = \&_expand;
    *Language::Befunge::Storage::Generic::Vec::XS::expand = \&_expand;
    *Language::Befunge::Storage::Generic::Vec::expand     = \&_expand;

    # override IP->spush() to impose stack size checking
    my $_lbip_spush;
    BEGIN { $_lbip_spush = \&Language::Befunge::IP::spush; };
    sub _spush {
        my ($ip, @newvals) = @_;
        my $critter = $$ip{_ai_critter};
        return $ip->dir_reverse unless $critter->spend($critter->stackcost * scalar @newvals);
        my $rv = &$_lbip_spush(@_);
        return $rv;

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

# acts like "r" (reverse).
is($AI::Evolve::Befunge::Physics::test1::t, 0, "T command not called before");
$rv = newaebc("1T1MqT5", 7, 1, Tokens => 50)->move();
ok(!$rv->died, "did not die");
is($AI::Evolve::Befunge::Physics::test1::t, 7, "T command had expected effect");
BEGIN { $num_tests += 3 };


my $befunge = $$critter{interp};
my $ls = $befunge->get_storage;
lives_ok{$ls->expand(v(4, 4, 4, 4))} "expand bounds checking";
dies_ok {$ls->expand(v(4, 4, 4, 5))} "expand bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
dies_ok {$ls->expand(v(4, 4, 5, 4))} "expand bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
dies_ok {$ls->expand(v(4, 5, 4, 4))} "expand bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
dies_ok {$ls->expand(v(5, 4, 4, 4))} "expand bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
lives_ok{$ls->expand(v(-4,-4,-4,-4))} "set_min bounds checking";
dies_ok {$ls->expand(v(-4,-4,-4,-5))} "set_min bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
dies_ok {$ls->expand(v(-4,-4,-5,-4))} "set_min bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
dies_ok {$ls->expand(v(-4,-5,-4,-4))} "set_min bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
dies_ok {$ls->expand(v(-5,-4,-4,-4))} "set_min bounds checking";
like($@, qr/out of bounds/, "out of bounds detection");
BEGIN { $num_tests += 18 };


BEGIN { plan tests => $num_tests };


package AI::Evolve::Befunge::Physics::test1;
use strict;
use warnings;