view release on metacpan or  search on metacpan

t/BioDBGFF.t  view on Meta::CPAN

  @features = sort $segment1->features('aggregated_transcript');   # sort so that trans-1 comes first
  is(scalar @features,2);
  cmp_ok($features[0]->Exon, '>', 0);
  cmp_ok($features[0]->Cds,'>', 0);

  # Test that sorting is correct.  The way that test.gff is set up, the lower one is
  # on the + strand and the higher is on the -.
  @features = sort {$a->start <=> $b->start} @features;
  is($features[0]->strand,1);
  is($features[1]->strand,-1);

  my $last = 0;
  $inconsistency = 0;
  foreach ($features[0]->Exon) {
    $inconsistency++ if $_->start > $_->end;
    $inconsistency++ if $last && $_->start < $last;
    $last = $_->start;
  }
  ok(!$inconsistency);

  $inconsistency = $last = 0;
  foreach ($features[1]->Exon) {
    $inconsistency++ if $_->start < $_->end;
    $inconsistency++ if $last && $_->start > $last;
    $last = $_->start;
  }
  ok(!$inconsistency);

  # relative addressing in aggregated features
  my $transcript1 = $db->segment($features[0]);
  $transcript1->ref($features[0]);
  my @overlap     = sort {$a->start <=> $b->start } $transcript1->features;
  is(scalar(@overlap),5);
  is($overlap[0]->start,-999);

  $transcript1 = $db->segment('Transcript' => 'trans-1');
  @overlap     = sort {$a->start <=> $b->start } $transcript1->features;
  is($overlap[0]->start,-999);

  # test strandedness of features
  $segment1 = $db->segment('-class' => 'Transcript',
			   '-name'  => 'trans-3',
			   '-start' => 1,
			   '-stop'  => 6000);
  is($segment1->strand,1);
  @overlap  = sort {$a->start <=> $b->start} $segment1->features('transcript');
  is(scalar(@overlap),2);
  is($overlap[0]->name,'trans-3');
  is($overlap[1]->name,'trans-4');
  is($overlap[0]->strand,1);
  is($overlap[1]->strand,-1);

  # testing feature id and group_id
  my $tf = $overlap[0];
  ok(defined $tf->id);
  my $t1 = $db->fetch_feature_by_id($tf->id);
  is($t1->id,$tf->id);

  SKIP: {
    if (defined $tf->group_id) {
      my $t2 = $db->fetch_feature_by_gid($tf->group_id);
      is($t2->group_id,$tf->group_id);
      is($t2->group_id,$t1->group_id);
    } else {
      skip("fetch_feature_by_gid() not implemented by this adaptor",2);
    }
  }

  $segment1 = $db->segment('-class' => 'Transcript',
			   '-name'  => 'trans-4',
			   '-start' => 1,
			   '-stop'  => 6000);
  is($segment1->strand,1);
  @overlap = sort {$a->start <=> $b->start} $segment1->features('transcript');
  is($overlap[0]->name,'trans-4');
  is($overlap[1]->name,'trans-3');
  is($overlap[0]->strand,1);
  is($overlap[1]->strand,-1);

  @overlap = sort {$a->start <=> $b->start} $segment1->features('Component');
  is($overlap[0]->strand,0);

SKIP: {
  # test preferred group assignments
  if ($FILE =~ /\.gff$/) {
    my @gene = $db->get_feature_by_name( gene => 'gene-9' );
    my @mrna = $db->get_feature_by_name( mRNA => 'trans-9' );
    is($gene[0]->ref, 'Contig4');
    is(scalar(@gene), 2);
    is(scalar(@mrna), 1);
  } else {
    skip('preferred groups are not supported by gff3',3);
  }
}

  # test iterator across a segment
  $segment1 = $db->segment('Contig1');
  my $i = $segment1->features('-automerge'=>0,'-iterator'=>1);
  my %strand;
  while (my $s = $i->next_feature) {
    $strand{$s->strand}++;
  }
  is(keys %strand, 3);

  # test iterator across entire database
  $i = $db->features('-automerge'=>0,'-iterator'=>1);
  %strand = ();
  while (my $s = $i->next_feature) {
    $strand{$s->strand}++;
  }
  is(keys %strand, 3);

  # test iterator across a segment, limited by an attribute
  $i = $seg->get_feature_stream(-attributes=>{'Gene'=>'abc-1',Note=>'function unknown'});
  my $count = 0;
  while ($i->next_seq) {
    $count++;
  }
  is($count,2);

  # test that aliases work
  my $st1 = $db->segment(Transcript => 'trans-3');
  ok($st1);
  my $st2 = $db->segment(Transcript => 'trans-18');  # this is an alias!
  ok($st2);