t/GFF.t

   1 #-*-Perl-*-
   2 ## Bioperl Test Harness Script for Modules
   3
   4 # Before `make install' is performed this script should be runnable with
   5 # `make test'. After `make install' it should work as `perl test.t'
   6
   7 use strict;
   8
   9 BEGIN {
  10     # to handle systems with no installed Test module
  11     # we include the t dir (where a copy of Test.pm is located)
  12     # as a fallback
  13     eval { require Test::More; };
  14     if( $@ ) {
  15         use lib 't/lib';
  16     }
  17     use Test::More;
  18     plan tests => 36;
  19     use_ok('Bio::Seq');
  20     use_ok('Bio::Tools::GFF');
  21     use_ok('Bio::SeqFeatureI');
  22     use_ok('Bio::SeqFeature::Generic');
  23 }
  24
  25 END {
  26     unlink("out1.gff", "out2.gff");
  27 }
  28
  29 my $feat = new Bio::SeqFeature::Generic( -start => 10, -end => 100,
  30                                 -strand => -1, -primary => 'repeat',
  31                                 -source => 'repeatmasker',
  32                                 -score  => 1000,
  33                                 -tag    => {
  34                                     new => 1,
  35                                     author => 'someone',
  36                                     sillytag => 'this is silly!;breakfast' } );
  37 ok($feat);
  38 my $gff1out = Bio::Tools::GFF->new(-gff_version => 1, -file => ">out1.gff");
  39 ok($gff1out);
  40 my $gff2out = Bio::Tools::GFF->new(-gff_version => 2, -file => ">out2.gff");
  41 ok($gff2out);
  42
  43 $gff1out->write_feature($feat);
  44 $gff2out->write_feature($feat);
  45
  46 $gff1out->close();
  47 $gff2out->close();
  48
  49 my $gff1in = Bio::Tools::GFF->new(-gff_version => 1,  -file => "out1.gff");
  50 ok($gff1in);
  51 my $gff2in = Bio::Tools::GFF->new(-gff_version => 2, -file => "out2.gff");
  52 ok($gff2in);
  53
  54 my $feat1 = $gff1in->next_feature();
  55 ok($feat1);
  56 is($feat1->start, $feat->start);
  57 is($feat1->end, $feat->end);
  58 is($feat1->primary_tag, $feat->primary_tag);
  59 is($feat1->score, $feat->score);
  60
  61 my $feat2 = $gff2in->next_feature();
  62 ok($feat2);
  63 is($feat2->start, $feat->start);
  64 is($feat2->end, $feat->end);
  65 is($feat2->primary_tag, $feat->primary_tag);
  66 is($feat2->score, $feat->score);
  67 is(($feat2->each_tag_value('sillytag'))[0], 'this is silly!;breakfast');
  68
  69 #test sequence-region parsing
  70 $gff2in = Bio::Tools::GFF->new(-gff_version => 2, -file => Bio::Root::IO->catfile("t","data","hg16_chroms.gff"));
  71 is($gff2in->next_feature(),undef);
  72 my $seq = $gff2in->next_segment;
  73 is($seq->display_id, 'chr1');
  74 is($seq->end, 246127941);
  75 is($seq->start, 1);
  76
  77
  78 # GFF3
  79 SKIP: {
  80     eval { require IO::String };
  81     skip('cannot verify GFF3 writing tests without IO::String installed',12)
  82         if $@;
  83     my $str = IO::String->new;
  84     my $gffout = new Bio::Tools::GFF(-fh => $str, -gff_version => 3);
  85     my $feat_test = new Bio::SeqFeature::Generic
  86     (-primary_tag => 'tag',
  87      -source_tag  => 'exon',
  88      -seq_id      => 'testseq',
  89      -score       => undef,
  90      -start       => 10,
  91      -end         => 120,
  92      -strand      => 1,
  93      -tag         => {
  94          'bungle' => 'jungle;mumble',
  95          'lion'   => 'snake=tree'
  96          });
  97     $feat_test->add_tag_value('giant_squid', 'lakeshore manor');
  98     $gffout->write_feature($feat_test);
  99     seek($str,0,0);
 100     my $in = new Bio::Tools::GFF(-fh          => $str,
 101                  -gff_version => 3);
 102     my $f_recon = $in->next_feature;
 103     is($f_recon->primary_tag, $feat_test->primary_tag);
 104     is($f_recon->source_tag,  $feat_test->source_tag);
 105     is($f_recon->score, $feat_test->score);
 106     is($f_recon->start, $feat_test->start);
 107     is($f_recon->end, $feat_test->end);
 108     is($f_recon->strand, $feat_test->strand);
 109     for my $tag ( $feat_test->get_all_tags ) {
 110         ok($f_recon->has_tag($tag));
 111         if( $f_recon->has_tag($tag) ) {
 112             my @v = $feat_test->get_tag_values($tag);
 113             my @g = $f_recon->get_tag_values($tag);
 114             while( @v && @g ) {
 115                is(shift @v, shift @g);
 116             }
 117         }
 118     }
 119 }
 120
 121