t/Seq/LargePSeq.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 => 30);
  10
  11         use_ok('Bio::Seq::LargePrimarySeq');
  12         use_ok('Bio::Seq::LargeSeq');
  13         use_ok('Bio::Location::Simple');
  14         use_ok('Bio::Location::Fuzzy');
  15         use_ok('Bio::Location::Split');
  16         use_ok('Bio::SeqIO');
  17 }
  18
  19 my $pseq = Bio::Seq::LargePrimarySeq->new();
  20 ok $pseq;
  21 $pseq->add_sequence_as_string('ATGGGGTGGGGTGAAACCCTTTGGGGGTGGGGTAAAT');
  22 $pseq->add_sequence_as_string('GTTTGGGGTTAAACCCCTTTGGGGGGT');
  23
  24 is $pseq->display_id('hello'), 'hello';
  25
  26 is $pseq->seq, 'ATGGGGTGGGGTGAAACCCTTTGGGGGTGGGGTAAATGTTTGGGGTTAAACCCCTTTGGGGGGT' , "Sequence is " . $pseq->seq;
  27
  28 is $pseq->subseq(3,7), 'GGGGT', "Subseq is ".$pseq->subseq(3,7);
  29 my $location = Bio::Location::Simple->new(-start => 4, -end => 8,
  30                                          -strand => 1);
  31 is($pseq->subseq($location), 'GGGTG');
  32
  33 my $splitlocation = Bio::Location::Split->new();
  34
  35 $splitlocation->add_sub_Location( Bio::Location::Simple->new('-start' => 1,
  36                                                             '-end'   => 15,
  37                                                             '-strand' => 1));
  38
  39 $splitlocation->add_sub_Location( Bio::Location::Simple->new('-start' => 21,
  40                                                             '-end'   => 27,
  41                                                             '-strand' => -1));
  42
  43 is( $pseq->subseq($splitlocation), 'ATGGGGTGGGGTGAACCCCCAA');
  44
  45 my $fuzzy = Bio::Location::Fuzzy->new(-start => '<10',
  46                                      -end   => '18',
  47                                      -strand => 1);
  48
  49 is( $pseq->subseq($fuzzy), 'GGTGAAACC');
  50
  51
  52 is($pseq->trunc(8,15)->seq, 'GGGGTGAA',
  53     'trunc seq was ' . $pseq->trunc(8,15)->seq);
  54
  55
  56 is $pseq->alphabet('dna'), 'dna'; # so translate will not complain
  57 is $pseq->translate()->seq, 'MGWGETLWGWGKCLGLNPFGG';
  58
  59
  60 my $seq = Bio::Seq::LargeSeq->new(-primaryseq => $pseq );
  61
  62 is $seq->display_id('hello'), 'hello';
  63
  64 is $seq->seq, 'ATGGGGTGGGGTGAAACCCTTTGGGGGTGGGGTAAATGTTTGGGGTTAAACCCCTTTGGGGGGT' , "Sequence is " . $seq->seq;
  65
  66 # test SeqIO::fasta (allows LargeSeqI; bug 2490)
  67
  68 SKIP: {
  69     eval {require IO::String};
  70     skip "SeqIO output for LargeSeq requires IO::String", 2 if $@;
  71         my $str;
  72         my $strobj = IO::String->new($str);
  73         my $out = Bio::SeqIO->new(-fh => $strobj, -format => 'fasta');
  74     ok($out->write_seq($seq));
  75         like($str, qr/>hello\nATGGGGTGGGGTGAAACCCTTTGGGGGTGGGGTAAATGTTTGGGGTTAAACCCCTTTGGG\nGGGT/,
  76                  'output via Bio::SeqIO::fasta');
  77 }
  78
  79 is $seq->subseq(3,7), 'GGGGT', "Subseq is ".$seq->subseq(3,7);
  80 is ($seq->trunc(8,15)->seq, 'GGGGTGAA',
  81     'trunc seq was ' . $seq->trunc(8,15)->seq);
  82
  83 is $seq->alphabet('dna'), 'dna'; # so translate will not complain
  84 is $seq->translate()->seq, 'MGWGETLWGWGKCLGLNPFGG';
  85
  86 $seq = Bio::Seq::LargeSeq->new( -display_id => 'hello');
  87 $seq->seq('ATGGGGTGGGGT');
  88 is $seq->display_id, 'hello';
  89
  90 is $seq->seq, 'ATGGGGTGGGGT' , "Sequence is " . $seq->seq;
  91
  92 is $seq->subseq(3,7), 'GGGGT', "Subseq is ".$seq->subseq(3,7);
  93 is ($seq->trunc(8,12)->seq, 'GGGGT',
  94     'trunc seq was ' . $seq->trunc(8,12)->seq);
  95
  96 is $seq->alphabet('dna'), 'dna'; # so translate will not complain
  97 is $seq->translate()->seq, 'MGWG';