view release on metacpan or  search on metacpan

t/tgene.t  view on Meta::CPAN

  return $self;
}

sub seed_gene {
  my $self = shift;
  $self->[0] = join('', 'a'..'j');
  @{$self->[1]} = ('a'..'j');
  return 1;
}

sub generate_token {
  my $self = shift;
  my ($type, $prev) = @_;
  $type ||= 'n';
  $prev = uc $type;
  return ($type, $prev);
}

sub d {
  my $self = shift;
  return $self->[0];
}

sub g {
  my $self = shift;
  return join('', @{$self->[1]});
}

package main;
use Test;
# see above for a small package ( GTest ) used to test G::G::S
BEGIN {plan tests => 111, todo =>[]}
my $hammer = 30; # set big to bash at methods with randomness

{ # test1
  # first of all, does our testing package behave
  my $gene = GTest->new;
  die "$0: Broken render" unless $gene->d eq 'abcdefghij'
                            and $gene->g eq 'abcdefghij';
  die "$0: Broken generate" unless ($gene->generate_token('a'))[1] eq 'A'
    and ($gene->generate_token())[0] eq 'n';
  ok(1);
}
my $main = GTest->new;
{ print "# clone\n";
  my $gene = $main->clone;
  ok($gene->g, $main->g);
}

{ print "# mutate_minor\n";
  my $gene = $main->clone;
  my $rt = $gene->mutate_minor(1);
  ok ($rt, 1); # return value
  ok ($gene->g ne $main->g); # changed
  $gene = $main->clone;
  $gene->mutate_minor(1,0);
  ok ($gene->g, 'Abcdefghij');
  $rt = $gene->mutate_minor(1,10); # outside of gene
  ok ($rt,0);
  ok ($gene->g, 'Abcdefghij');
  # hammer randomness, check for errors
  $rt = 0;
  for (1..$hammer) {
    eval '$gene->mutate_minor()';
    $rt = 1 if $@;
  }
  ok($rt,0);
}

{ print "# mutate_major\n";
  my $gene = $main->clone;
  my $rt = $gene->mutate_major(1,0);
  ok($rt, 1);
  ok($gene->g, 'Nbcdefghij');
  $gene = $main->clone;
  $gene->mutate_major;
  ok($gene->g ne $main->g, 1);
  $gene = $main->clone;
  $rt = $gene->mutate_major(1,10); # outside of gene
  ok($rt,0);
  ok($gene->g eq $main->g);
  # hammer randomness
  $rt = 0;
  for (1..$hammer) {
    eval '$gene->mutate_major()';
    $rt = 1 if $@;
  }
  ok($rt,0);
}

{ print "# mutate_remove\n";
  my $gene = $main->clone;
  my $rt = $gene->mutate_remove(1,0);
  ok($rt,1);
  ok($gene->g eq 'bcdefghij' and $gene->d eq 'bcdefghij');
  $rt = $gene->mutate_remove(1,0,2);
  ok($rt,1);
  ok($gene->g eq 'defghij' and $gene->d eq 'defghij');
  $rt = $gene->mutate_remove(1,7); # outside of gene
  ok($rt,0);
  ok($gene->g eq 'defghij');
  $rt = $gene->mutate_remove(1,5,5); # extends beyond gene
  ok($rt,1);
  ok($gene->g eq 'defgh');
  # hammer randomness
  $rt = 0;
  for (1..$hammer) {
    $gene = $main->clone;
    eval '$gene->mutate_remove(1,undef,0)';
    $rt = 1 if $@;
  }
  ok($rt,0);
}

{ print "# mutate_insert\n";
  my $gene = $main->clone;
  my $rt = $gene->mutate_insert(1,0);
  ok($rt,1);
  ok($gene->g eq 'Nabcdefghij' and $gene->d eq 'nabcdefghij');
  $gene = $main->clone;
  $rt = $gene->mutate_insert(1,10); # last possible pos