1# -*-Perl-*- Test Harness script for Bioperl
2# $Id$
3
4use strict;
5
6BEGIN {
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
19my $pseq = Bio::Seq::LargePrimarySeq->new();
20ok $pseq;
21$pseq->add_sequence_as_string('ATGGGGTGGGGTGAAACCCTTTGGGGGTGGGGTAAAT');
22$pseq->add_sequence_as_string('GTTTGGGGTTAAACCCCTTTGGGGGGT');
23
24is $pseq->display_id('hello'), 'hello';
25
26is $pseq->seq, 'ATGGGGTGGGGTGAAACCCTTTGGGGGTGGGGTAAATGTTTGGGGTTAAACCCCTTTGGGGGGT' , "Sequence is " . $pseq->seq;
27
28is $pseq->subseq(3,7), 'GGGGT', "Subseq is ".$pseq->subseq(3,7);
29my $location = Bio::Location::Simple->new(-start => 4, -end => 8,
30					 -strand => 1);
31is($pseq->subseq($location), 'GGGTG');
32
33my $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
43is( $pseq->subseq($splitlocation), 'ATGGGGTGGGGTGAACCCCCAA');
44
45my $fuzzy = Bio::Location::Fuzzy->new(-start => '<10',
46				     -end   => '18',
47				     -strand => 1);
48
49is( $pseq->subseq($fuzzy), 'GGTGAAACC');
50
51
52is($pseq->trunc(8,15)->seq, 'GGGGTGAA',
53    'trunc seq was ' . $pseq->trunc(8,15)->seq);
54
55
56is $pseq->alphabet('dna'), 'dna'; # so translate will not complain
57is $pseq->translate()->seq, 'MGWGETLWGWGKCLGLNPFGG';
58
59
60my $seq = Bio::Seq::LargeSeq->new(-primaryseq => $pseq );
61
62is $seq->display_id('hello'), 'hello';
63
64is $seq->seq, 'ATGGGGTGGGGTGAAACCCTTTGGGGGTGGGGTAAATGTTTGGGGTTAAACCCCTTTGGGGGGT' , "Sequence is " . $seq->seq;
65
66# test SeqIO::fasta (allows LargeSeqI; bug 2490)
67
68SKIP: {
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
79is $seq->subseq(3,7), 'GGGGT', "Subseq is ".$seq->subseq(3,7);
80is ($seq->trunc(8,15)->seq, 'GGGGTGAA',
81    'trunc seq was ' . $seq->trunc(8,15)->seq);
82
83is $seq->alphabet('dna'), 'dna'; # so translate will not complain
84is $seq->translate()->seq, 'MGWGETLWGWGKCLGLNPFGG';
85
86$seq = Bio::Seq::LargeSeq->new( -display_id => 'hello');
87$seq->seq('ATGGGGTGGGGT');
88is $seq->display_id, 'hello';
89
90is $seq->seq, 'ATGGGGTGGGGT' , "Sequence is " . $seq->seq;
91
92is $seq->subseq(3,7), 'GGGGT', "Subseq is ".$seq->subseq(3,7);
93is ($seq->trunc(8,12)->seq, 'GGGGT',
94    'trunc seq was ' . $seq->trunc(8,12)->seq);
95
96is $seq->alphabet('dna'), 'dna'; # so translate will not complain
97is $seq->translate()->seq, 'MGWG';
98