t/Seq/EncodedSeq.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib '.';
   8     use Bio::Root::Test;
   9
  10     test_begin(-tests => 37);
  11
  12     use_ok('Bio::Seq::EncodedSeq');
  13 }
  14
  15
  16 my ($str, $aln, $seq, $loc);
  17
  18 ok $seq = Bio::Seq::EncodedSeq->new(
  19                  -seq    => '--atg---gta--',
  20                  -start  => 1,
  21                  -end    => 6,
  22                  -strand => 1
  23                  );
  24 is $seq->alphabet, 'dna';
  25 is $seq->start, 1;
  26 is $seq->end, 6;
  27 is $seq->strand, 1;
  28 is $seq->num_gaps, 1;
  29 is $seq->column_from_residue_number(4), 9;
  30
  31 # this should fail
  32 eval {
  33     $seq->column_from_residue_number(8);
  34 };
  35 ok $@;
  36
  37 ok $loc = $seq->location_from_column(4);
  38 isa_ok $loc, 'Bio::Location::Simple';
  39 is $loc->to_FTstring, "2";
  40
  41 ok $loc = $seq->location_from_column(6);
  42 isa_ok $loc,'Bio::Location::Simple';
  43 is $loc->start, 3;
  44 is $loc->location_type, 'IN-BETWEEN';
  45 is $loc->to_FTstring, '3^4';
  46
  47 is $loc = $seq->location_from_column(2), undef;
  48
  49 is $seq->encoding, "GGCCCGGGCCCGG";
  50 is $seq->encoding(-explicit => 1), "GGCDEGGGCDEGG";
  51
  52 ok $seq = Bio::Seq::EncodedSeq->new(
  53                  -seq    => 'atcgta',
  54                  -start  => 10,
  55                  -end    => 15,
  56                  -strand => -1,
  57                  );
  58 is $seq->encoding('CCGGG'), 'CCGGGCCCC';
  59 is $seq->seq, 'atcg---ta';
  60 is $seq->column_from_residue_number(14), 2;
  61 is $seq->encoding('3C2GCG'), 'CCCGGCGCC';
  62 is $seq->seq, 'at-c--gta';
  63 is $seq->num_gaps, 2;
  64 is $seq->location_from_column(2)->to_FTstring, 14;
  65 is $seq->location_from_column(5)->to_FTstring, "12^13";
  66 is $seq->encoding("B", Bio::Location::Simple->new(-start => 10, -end => 11,
  67                           -location_type => 'IN-BETWEEN')), 'B';
  68 is $seq->seq, 'at-c--gt-a';
  69 is $seq->encoding, 'CBCCGGCGCC';
  70 is $seq->cds(-nogaps => 1)->seq, 'tacgat';
  71 is $seq->translate->seq, 'YD';
  72 ok $seq = $seq->trunc(4,10); # kinda testing LocatableSeq's new trunc() here as well.
  73 is $seq->seq, 'c--gt-a';
  74 is $seq->encoding, 'CBCCGGC';