t/Seq/EncodedSeq.t

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