A test to ensure Bio::PrimarySeqI->trunc() doesn't use clone() for a Bio::Seq::RichSe...
[bioperl-live.git] / t / Seq / LargePSeq.t
blob5b96d84fba05f5c5f575a0829cb24d02089d7a24
1 # -*-Perl-*- Test Harness script for Bioperl
2 # $Id$
4 use strict;
6 BEGIN {     
7     use lib '.';
8     use Bio::Root::Test;
9     
10     test_begin(-tests => 30);
11         
12         use_ok('Bio::Seq::LargePrimarySeq');
13         use_ok('Bio::Seq::LargeSeq');
14         use_ok('Bio::Location::Simple');
15         use_ok('Bio::Location::Fuzzy');
16         use_ok('Bio::Location::Split');
17         use_ok('Bio::SeqIO');
20 my $pseq = Bio::Seq::LargePrimarySeq->new();
21 ok $pseq;
22 $pseq->add_sequence_as_string('ATGGGGTGGGGTGAAACCCTTTGGGGGTGGGGTAAAT');
23 $pseq->add_sequence_as_string('GTTTGGGGTTAAACCCCTTTGGGGGGT');
25 is $pseq->display_id('hello'), 'hello';
27 is $pseq->seq, 'ATGGGGTGGGGTGAAACCCTTTGGGGGTGGGGTAAATGTTTGGGGTTAAACCCCTTTGGGGGGT' , "Sequence is " . $pseq->seq;
29 is $pseq->subseq(3,7), 'GGGGT', "Subseq is ".$pseq->subseq(3,7);
30 my $location = Bio::Location::Simple->new(-start => 4, -end => 8,
31                                          -strand => 1);
32 is($pseq->subseq($location), 'GGGTG');
34 my $splitlocation = Bio::Location::Split->new();
36 $splitlocation->add_sub_Location( Bio::Location::Simple->new('-start' => 1,
37                                                             '-end'   => 15,
38                                                             '-strand' => 1));
40 $splitlocation->add_sub_Location( Bio::Location::Simple->new('-start' => 21,
41                                                             '-end'   => 27,
42                                                             '-strand' => -1));
44 is( $pseq->subseq($splitlocation), 'ATGGGGTGGGGTGAACCCCCAA');
46 my $fuzzy = Bio::Location::Fuzzy->new(-start => '<10',
47                                      -end   => '18',
48                                      -strand => 1);
50 is( $pseq->subseq($fuzzy), 'GGTGAAACC');
53 is($pseq->trunc(8,15)->seq, 'GGGGTGAA',
54     'trunc seq was ' . $pseq->trunc(8,15)->seq);
57 is $pseq->alphabet('dna'), 'dna'; # so translate will not complain
58 is $pseq->translate()->seq, 'MGWGETLWGWGKCLGLNPFGG';
61 my $seq = Bio::Seq::LargeSeq->new(-primaryseq => $pseq );
63 is $seq->display_id('hello'), 'hello';
65 is $seq->seq, 'ATGGGGTGGGGTGAAACCCTTTGGGGGTGGGGTAAATGTTTGGGGTTAAACCCCTTTGGGGGGT' , "Sequence is " . $seq->seq;
67 # test SeqIO::fasta (allows LargeSeqI; bug 2490)
69 SKIP: {
70     eval {require IO::String};
71     skip "SeqIO output for LargeSeq requires IO::String", 2 if $@;
72         my $str;
73         my $strobj = IO::String->new($str);
74         my $out = Bio::SeqIO->new(-fh => $strobj, -format => 'fasta');
75     ok($out->write_seq($seq));
76         like($str, qr/>hello\nATGGGGTGGGGTGAAACCCTTTGGGGGTGGGGTAAATGTTTGGGGTTAAACCCCTTTGGG\nGGGT/,
77                  'output via Bio::SeqIO::fasta');
78 }                                                 
80 is $seq->subseq(3,7), 'GGGGT', "Subseq is ".$seq->subseq(3,7);
81 is ($seq->trunc(8,15)->seq, 'GGGGTGAA', 
82     'trunc seq was ' . $seq->trunc(8,15)->seq);
84 is $seq->alphabet('dna'), 'dna'; # so translate will not complain
85 is $seq->translate()->seq, 'MGWGETLWGWGKCLGLNPFGG';
87 $seq = Bio::Seq::LargeSeq->new( -display_id => 'hello');
88 $seq->seq('ATGGGGTGGGGT');
89 is $seq->display_id, 'hello';
91 is $seq->seq, 'ATGGGGTGGGGT' , "Sequence is " . $seq->seq;
93 is $seq->subseq(3,7), 'GGGGT', "Subseq is ".$seq->subseq(3,7);
94 is ($seq->trunc(8,12)->seq, 'GGGGT', 
95     'trunc seq was ' . $seq->trunc(8,12)->seq);
97 is $seq->alphabet('dna'), 'dna'; # so translate will not complain
98 is $seq->translate()->seq, 'MGWG';