t/Seq/PrimarySeq.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5 use Data::Dumper;
   6
   7 BEGIN {
   8     use lib '.';
   9     use Bio::Root::Test;
  10     test_begin( -tests => 312 );
  11
  12     use_ok('Bio::PrimarySeq');
  13     use_ok('Bio::Location::Simple');
  14     use_ok('Bio::Location::Fuzzy');
  15     use_ok('Bio::Location::Split');
  16 }
  17
  18
  19 # Bare object
  20 ok my $seq = Bio::PrimarySeq->new(), 'Bare object';
  21 isa_ok $seq, 'Bio::PrimarySeqI';
  22 is $seq->id, undef;
  23 is $seq->seq, undef;
  24 is $seq->length, 0;
  25 is $seq->alphabet, undef;
  26 is $seq->is_circular, undef;
  27
  28
  29 # Empty sequence
  30 ok $seq = Bio::PrimarySeq->new( -seq => '', -nowarnonempty => 1);
  31 is $seq->seq, '';
  32 is $seq->length, 0;
  33 is $seq->alphabet, undef;
  34
  35
  36 # Basic tests
  37 ok $seq = Bio::PrimarySeq->new(
  38     '-seq'              => 'TTGGTGGCGTCAACT',
  39     '-display_id'       => 'new-id',
  40     '-alphabet'         => 'dna',
  41     '-accession_number' => 'X677667',
  42     '-desc'             => 'Sample Bio::Seq object'
  43 );
  44 ok defined $seq;
  45 is $seq->accession_number(), 'X677667';
  46 is $seq->seq(),              'TTGGTGGCGTCAACT';
  47 is $seq->display_id(),       'new-id';
  48 is $seq->alphabet(),         'dna';
  49 is $seq->is_circular(),      undef;
  50 ok $seq->is_circular(1);
  51 is $seq->is_circular(0),     0;
  52
  53 # check IdentifiableI and DescribableI interfaces
  54 isa_ok $seq, 'Bio::IdentifiableI';
  55 isa_ok $seq, 'Bio::DescribableI';
  56
  57 # make sure all methods are implemented
  58 is $seq->authority("bioperl.org"), "bioperl.org";
  59 is $seq->authority, "bioperl.org";
  60 is $seq->namespace("t"), "t";
  61 is $seq->namespace, "t";
  62 is $seq->version(0), 0;
  63 is $seq->version, 0;
  64 is $seq->lsid_string(), "bioperl.org:t:X677667";
  65 is $seq->namespace_string, "t:X677667.0";
  66 is $seq->version(47), 47;
  67 is $seq->version, 47;
  68 is $seq->namespace_string, "t:X677667.47";
  69 is $seq->description, 'Sample Bio::Seq object';
  70 is $seq->display_name, "new-id";
  71
  72
  73 # Test subseq
  74 is $seq->subseq(2, 5), 'TGGT';
  75
  76 is $seq->subseq( -start => 1, -end => 15), 'TTGGTGGCGTCAACT';
  77
  78 my $location = Bio::Location::Simple->new(
  79     '-start'  => 2,
  80     '-end'    => 5,
  81     '-strand' => -1
  82 );
  83 is $seq->subseq($location), 'ACCA';
  84
  85 my $splitlocation = Bio::Location::Split->new();
  86 $splitlocation->add_sub_Location(
  87     Bio::Location::Simple->new(
  88         '-start'  => 1,
  89         '-end'    => 4,
  90         '-strand' => 1
  91     )
  92 );
  93
  94 $splitlocation->add_sub_Location(
  95     Bio::Location::Simple->new(
  96         '-start'  => 7,
  97         '-end'    => 12,
  98         '-strand' => -1
  99     )
 100 );
 101
 102 is $seq->subseq($splitlocation), 'TTGGTGACGC';
 103
 104 my $fuzzy = Bio::Location::Fuzzy->new(
 105     -start  => '<3',
 106     -end    => '8',
 107     -strand => 1
 108 );
 109
 110 is $seq->subseq($fuzzy), 'GGTGGC';
 111
 112 {
 113     ok my $seq = Bio::PrimarySeq->new( -seq => 'TT-GTGGCGTCAACT' );
 114     is $seq->subseq(2, 5, 'nogap'), 'TGT';
 115     is $seq->subseq( -start => 2, -end => 5, -nogap => 1 ), 'TGT';
 116     my $location = Bio::Location::Simple->new(
 117        '-start'  => 2,
 118        '-end'    => 5,
 119        '-strand' => 1
 120     );
 121     is $seq->subseq( $location, -nogap => 1), 'TGT';
 122
 123     is $seq->subseq(-start=>2, -end=>5, -replace_with=>'aa'), 'T-GT';
 124     is $seq->seq, 'TaaGGCGTCAACT';
 125
 126     throws_ok { $seq->subseq(-start=>2, -end=>5, -replace_with=>'?!'); } qr/.+/;
 127 }
 128
 129 {
 130     ok my $seq = Bio::PrimarySeq->new( -seq => 'AACCGGTT', -is_circular => 1 );
 131     is $seq->subseq( -start => 7, -end => 10 ), 'TTAA';
 132 }
 133
 134 ### Test for Bug #2936
 135 # Without strand input argument (case: user don't think is necessary)
 136 my $split_loc_obj1 = Bio::Location::Split->new();
 137 $split_loc_obj1->add_sub_Location(
 138     Bio::Location::Simple->new(
 139         '-start'  => 1,
 140         '-end'    => 10
 141     )
 142 );
 143 $split_loc_obj1->add_sub_Location(
 144     Bio::Location::Simple->new(
 145         '-start'  => 20,
 146         '-end'    => 30
 147     )
 148 );
 149 # With strand input argument (case: user provides the argument)
 150 my $split_loc_obj2 = Bio::Location::Split->new();
 151 $split_loc_obj2->add_sub_Location(
 152     Bio::Location::Simple->new(
 153         '-start'  => 1,
 154         '-end'    => 10,
 155         '-strand' => 1
 156     )
 157 );
 158 $split_loc_obj2->add_sub_Location(
 159     Bio::Location::Simple->new(
 160         '-start'  => 20,
 161         '-end'    => 30,
 162         '-strand' => 1
 163     )
 164 );
 165 is $split_loc_obj1->to_FTstring, "join(1..10,20..30)";
 166 is $split_loc_obj2->to_FTstring, "join(1..10,20..30)";
 167 $split_loc_obj1->flip_strand;
 168 $split_loc_obj2->flip_strand;
 169 is $split_loc_obj1->to_FTstring, "complement(join(1..10,20..30))";
 170 is $split_loc_obj2->to_FTstring, "complement(join(1..10,20..30))";
 171 ###
 172
 173 # Test trunc
 174 my $trunc = $seq->trunc( 1, 4 );
 175 isa_ok $trunc, 'Bio::PrimarySeqI';
 176 is $trunc->seq(), 'TTGG' or diag( "Expecting TTGG. Got " . $trunc->seq() );
 177
 178 $trunc = $seq->trunc($splitlocation);
 179 isa_ok $trunc, 'Bio::PrimarySeqI' ;
 180 is $trunc->seq(), 'TTGGTGACGC';
 181
 182 $trunc = $seq->trunc($fuzzy);
 183 isa_ok $trunc, 'Bio::PrimarySeqI';
 184 is $trunc->seq(), 'GGTGGC';
 185
 186 my $rev = $seq->revcom();
 187 isa_ok $rev, 'Bio::PrimarySeqI';
 188
 189 is $rev->seq(), 'AGTTGACGCCACCAA'
 190   or diag( 'revcom() failed, was ' . $rev->seq() );
 191
 192 is $rev->display_id,         'new-id';
 193 is $rev->display_name(),     'new-id';
 194 is $rev->accession_number(), 'X677667';
 195 is $rev->alphabet,           'dna';
 196 is $rev->description,        'Sample Bio::Seq object';
 197 is $rev->is_circular(),      0;
 198 is $rev->version,            47;
 199 is $rev->authority,          'bioperl.org';
 200 is $rev->namespace,          't';
 201 is $rev->namespace_string(), 't:X677667.47';
 202
 203 #
 204 # Translate
 205 #
 206
 207 my $aa = $seq->translate();    # TTG GTG GCG TCA ACT
 208 is $aa->seq, 'LVAST', "Translation: " . $aa->seq;
 209
 210 # tests for non-standard initiator codon coding for
 211 # M by making translate() look for an initiator codon and
 212 # terminator codon ("complete", the 5th argument below)
 213 $seq->seq('TTGGTGGCGTCAACTTAA');    # TTG GTG GCG TCA ACT TAA
 214 $aa = $seq->translate( undef, undef, undef, undef, 1 );
 215 is $aa->seq, 'MVAST', "Translation: " . $aa->seq;
 216
 217 # same test as previous, but using named parameter
 218 $aa = $seq->translate( -complete => 1 );
 219 is $aa->seq, 'MVAST', "Translation: " . $aa->seq;
 220
 221 # find ORF, ignore codons outside the ORF or CDS
 222 $seq->seq('TTTTATGGTGGCGTCAACTTAATTT');    # ATG GTG GCG TCA ACT
 223 $aa = $seq->translate( -orf => 1 );
 224 is $aa->seq, 'MVAST*', "Translation: " . $aa->seq;
 225
 226 # smallest possible ORF
 227 $seq->seq("ggggggatgtagcccc");             # atg tga
 228 $aa = $seq->translate( -orf => 1 );
 229 is $aa->seq, 'M*', "Translation: " . $aa->seq;
 230
 231 # same as previous but complete, so * is removed
 232 $aa = $seq->translate(
 233     -orf      => 1,
 234     -complete => 1
 235 );
 236 is $aa->seq, 'M', "Translation: " . $aa->seq;
 237
 238 # ORF without termination codon
 239 # should warn, let's change it into throw for testing
 240 $seq->verbose(2);
 241 $seq->seq("ggggggatgtggcccc");    # atg tgg ccc
 242 eval { $seq->translate( -orf => 1 ); };
 243 like( $@, qr/\batgtggccc\b/i );
 244 $seq->verbose(-1);
 245 $aa = $seq->translate( -orf => 1 );
 246 is $aa->seq, 'MWP', "Translation: MWP";
 247 $seq->verbose(0);
 248
 249 # use non-standard codon table where terminator is read as Q
 250 $seq->seq('ATGGTGGCGTCAACTTAG');    # ATG GTG GCG TCA ACT TAG
 251 $aa = $seq->translate( -codontable_id => 6 );
 252 is $aa->seq, 'MVASTQ' or diag( "Translation: " . $aa->seq );
 253
 254 # insert an odd character instead of terminating with *
 255 $aa = $seq->translate( -terminator => 'X' );
 256 is $aa->seq, 'MVASTX' or diag( "Translation: " . $aa->seq );
 257
 258 # change frame from default
 259 $aa = $seq->translate( -frame => 1 );    # TGG TGG CGT CAA CTT AG
 260 is $aa->seq, 'WWRQL' or diag( "Translation: " . $aa->seq );
 261
 262 $aa = $seq->translate( -frame => 2 );    # GGT GGC GTC AAC TTA G
 263 is $aa->seq, 'GGVNL' or diag( "Translation: " . $aa->seq );
 264
 265 # TTG is initiator in Standard codon table? Afraid so.
 266 $seq->seq("ggggggttgtagcccc");           # ttg tag
 267 $aa = $seq->translate( -orf => 1 );
 268 is $aa->seq, 'L*' or diag( "Translation: " . $aa->seq );
 269
 270 # Replace L at 1st position with M by setting complete to 1
 271 $seq->seq("ggggggttgtagcccc");           # ttg tag
 272 $aa = $seq->translate(
 273     -orf      => 1,
 274     -complete => 1
 275 );
 276 is $aa->seq, 'M' or diag( "Translation: " . $aa->seq );
 277
 278 # Ignore non-ATG initiators (e.g. TTG) in codon table
 279 $seq->seq("ggggggttgatgtagcccc");        # atg tag
 280 $aa = $seq->translate(
 281     -orf      => 1,
 282     -start    => "atg",
 283     -complete => 1
 284 );
 285 is $aa->seq, 'M' or diag( "Translation: " . $aa->seq );
 286
 287 # test for character '?' in the sequence string
 288 is $seq->seq('TTGGTGGCG?CAACT'), 'TTGGTGGCG?CAACT';
 289
 290 # issue #105 - when there are starts and stops in both frame 0 and
 291 # frame 1, frame 0 start < frame 1 start, then should return the frame
 292 # 0 ORF per the pod ('the first orf') even if frame 1 stop < frame 0 stop
 293
 294 # Turn off warnings for a few tests
 295 my $verbosity = $seq->verbose();
 296 $seq->verbose(-1);
 297
 298 $seq->seq('ATGAATGTAAATAA');
 299 $aa = $seq->translate( -orf => 1 );
 300 my $aa0 = $seq->translate(-frame => 0);
 301
 302 is $aa->seq, $aa0->seq, "frame 0 start, frame 1 stop < frame 0 stop";
 303 $seq->seq('AAATGAATGTAAATAA');
 304 $aa = $seq->translate( -orf => 1, -frame=>1 );
 305 my $aa2 = $seq->translate(-frame => 2);
 306 is $aa->seq, $aa2->seq, "frame 1 start, frame 2 stop < frame 1 stop";
 307 # Turn 'em back on!
 308 $seq->verbose($verbosity);
 309
 310 # test for some aliases
 311 $seq = Bio::PrimarySeq->new(
 312     -id          => 'aliasid',
 313     -description => 'Alias desc'
 314 );
 315 is $seq->description, 'Alias desc';
 316 is $seq->display_id,  'aliasid';
 317
 318 # Test alphabet
 319
 320 ok $seq->seq('actgx');
 321 is $seq->alphabet, 'protein', 'Alphabet';
 322 ok $seq->seq('actge');
 323 is $seq->alphabet, 'protein';
 324 ok $seq->seq('actgf');
 325 is $seq->alphabet, 'protein';
 326 ok $seq->seq('actgi');
 327 is $seq->alphabet, 'protein';
 328 ok $seq->seq('actgj');
 329 is $seq->alphabet, 'protein';
 330 ok $seq->seq('actgl');
 331 is $seq->alphabet, 'protein';
 332 ok $seq->seq('actgo');
 333 is $seq->alphabet, 'protein';
 334 ok $seq->seq('actgp');
 335 is $seq->alphabet, 'protein';
 336 ok $seq->seq('actgq');
 337 is $seq->alphabet, 'protein';
 338 ok $seq->seq('actgz');
 339 is $seq->alphabet, 'protein';
 340 ok $seq->seq('actgn');
 341 is $seq->alphabet, 'dna';
 342 ok $seq->seq('acugn');
 343 is $seq->alphabet, 'rna';
 344 ok $seq->seq('bdhkm');
 345 is $seq->alphabet, 'protein';
 346 ok $seq->seq('rsvwx');
 347 is $seq->alphabet, 'protein';
 348 ok $seq->seq('AAACTYAAAAGAATTGRCGG'); # valid degenerate DNA PCR primer sequence (90% ACGTN)
 349 is $seq->alphabet, 'dna';
 350 ok $seq->seq('AAACTYAAAKGAATTGRCGG'); # another primer previously detected as protein (85% ACGTN)
 351 is $seq->alphabet, 'dna';
 352 ok $seq->seq('YWACTYAAAKGARTTGRCGG'); # 70% ACGTNWSRM. Everything <= 70% is considered a protein
 353 is $seq->alphabet, 'dna';
 354 ok $seq->seq('XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'); # Bug 2438
 355 is $seq->alphabet, 'protein', 'Bug 2438';
 356 ok $seq->seq('CAGTCXXXXXXXXXXXXXXXXXXXXXXXXXXXCAGCG');
 357 is $seq->alphabet, 'protein';
 358 ok $seq->seq('WTGGGGCTATGAAAAAAAAAWTTKMGMMAAAAAWTTWTKRWMRATC'); # showed up on MAKER list
 359 is $seq->alphabet, 'dna';
 360
 361 ok $seq->seq('actgn', 'protein'); # accept specified alphabet, no matter what
 362 is $seq->alphabet, 'protein';
 363 ok $seq->seq('bdhkm', 'dna');
 364 is $seq->alphabet, 'dna';
 365
 366
 367 # Bug #2864:
 368
 369 $seq = Bio::PrimarySeq->new( -display_id => 0, -seq => 'GATC' );
 370
 371 is $seq->display_id, 0, "Bug #2864";
 372
 373 # Test that the check for terminators inside the translated protein
 374 # works when the terminator isn't '*':
 375
 376 $seq = Bio::PrimarySeq->new(-seq=>'ATGCTCTAAGCAGGGTAA'); # ML*AG*
 377 eval { $aa = $seq->translate(-complete=>1, -throw=>1, -terminator=>'#') };
 378 my $error = $@;
 379 ok $error =~ /\QTerminator codon inside CDS!\E/, 'Terminator + inside sequence';
 380
 381 $seq = Bio::PrimarySeq->new(-seq=>'ATGCTCGCAGGGTAA'); # MLAG*
 382 $aa = $seq->translate(-complete=>1, -throw=>1, -terminator=>'#');
 383 is $aa->seq, 'MLAG';
 384
 385
 386 # Test length method
 387 ok $seq = Bio::PrimarySeq->new(), 'Length method';
 388 is $seq->length, 0;
 389 ok $seq->length(123);
 390 is $seq->length, 123;
 391
 392 ok $seq = Bio::PrimarySeq->new( -seq => 'ATGCTCTAAGCAGGGTAA' );
 393 is $seq->length, 18;
 394 ok $seq->seq('ATGCTCTAAG');
 395 is $seq->length, 10;
 396 is $seq->seq(undef), undef;
 397 is $seq->length, 0;
 398
 399 ok $seq = Bio::PrimarySeq->new( -length => 123 );
 400 is $seq->length, 123;
 401
 402 ok $seq = Bio::PrimarySeq->new( -seq => 'ATGCTCTAAGCAGGGTAA' );
 403 is $seq->length, 18;
 404 ok $seq->length( $seq->length ); # save memory by removing seq
 405 is $seq->seq( undef ), undef;    # ... but keeping a record of length
 406 is $seq->length, 18;
 407 is $seq->seq, undef;
 408 ok $seq->seq('ACGT');
 409 is $seq->length, 4; # manually-specified length changed when sequence is changed
 410
 411 throws_ok { $seq->length(666); } qr/.+/; # Cannot lie about length
 412
 413
 414 # Sequence validation method
 415 is $seq->validate_seq( undef    ), 1;
 416 is $seq->validate_seq( ''       ), 1;
 417 is $seq->validate_seq( 'acgt'   ), 1;
 418 is $seq->validate_seq( 'ACGT'   ), 1;
 419 is $seq->validate_seq( 'XFRH'   ), 1;
 420 is $seq->validate_seq( '-~'     ), 1; # gap symbols
 421 is $seq->validate_seq( '-.*?=~' ), 1; # other valid symbols
 422 is $seq->validate_seq( '0'      ), 0;
 423 is $seq->validate_seq( '   '    ), 0;
 424 is $seq->validate_seq( 'AAAA$'  ), 0;
 425 is $seq->validate_seq( 'tt&t!'  ), 0;
 426
 427 throws_ok { $seq->validate_seq('tt&t!', 1); } qr/.+/;
 428
 429
 430 # Test direct option (no sequence validation)
 431 throws_ok { $seq = Bio::PrimarySeq->new(-seq => 'A\T$AGQ+T'); } qr/.+/, 'Validation';
 432 ok $seq = Bio::PrimarySeq->new( -seq => 'A\T$AGQ+T', -direct => 1 );
 433 is $seq->seq, 'A\T$AGQ+T';
 434 throws_ok { $seq->seq('NT@/') } qr/.+/;
 435
 436 # Set a sequence by reference
 437 my $string = 'AAAACCCCGGGGTTTT';
 438 ok $seq = Bio::PrimarySeq->new( -ref_to_seq => \$string );
 439 is $seq->seq, 'AAAACCCCGGGGTTTT';
 440
 441
 442 # Test internal PrimarySeqI _find_orfs function and translate( -orf => 'longest' )
 443 {
 444     my @tests = (
 445         #tiny test
 446         ['TTTTATGGTGGCGTCAACTTAATTT',
 447          [[4,22,18,1]],
 448         ],
 449
 450         #bigger test (this is a tomato unigene)
 451         ['GAAGGCTGGTTCTGAGTTGGATCTATGTTTGATGAAGGGAAGTAGACCGGAGGTCTTGCATCAGCAATATTAGTACCAAATCCAGGTGGAGGCGCATCCTGTCTCCGTTGCATTTCAACTTTCATTTCAGCAATCTGTTGCATCAGTTGCATGATCAATTCATTCTGTTCCACTACAGTGGGCTGAGCGACCACAACGTCAGTAAGACGCCCTTCGTCATTGTTGTCTCCCATAACTGTTTTTCCTTTATCTGAATTTGATCGAGGGAAGGAATCTGTAGGACCTTTCGATCTGGTGAAGTAAGGATGATCTGCCAGCTTTATTGACACAGATCAGTAAAAAGGTACCTGAAAGGTAAAAACAACTCAAAGGCAAATTTGTTAGTGCATATCCAGAGTACAAAATGCTTAATATCGCACATAAAACCGATAAACACACAAGTCGTTTTGTTTGAGGATATCTTAACCCACGAATAAGGACGGATATATATTTTGAACAAACAGGAATTTGTTTGTTTGGCGTTATCTTGGGAAATCTG',
 452          [[98,254,156,2],[347,476,129,2],[219,303,84,0],[16,73,57,1],[403,454,51,1],[310,358,48,1],[235,280,45,1],[491,536,45,2],[150,186,36,0],[507,537,30,0],[5,32,27,2],[511,538,27,1],[24,45,21,0],[305,326,21,2],[450,465,15,0]],
 453         ],
 454
 455
 456        );
 457     foreach my $test (@tests) {
 458         my ($test_seq, $orfs) = @$test;
 459         my @orfs = Bio::PrimarySeqI::_find_orfs_nucleotide(
 460             undef,
 461             $test_seq,
 462             Bio::Tools::CodonTable->new,
 463             undef,
 464            ); # ATG GTG GCG TCA ACT
 465         is_deeply( \@orfs, $orfs, '_find_orfs 1')
 466             or diag "for $test_seq, _find_orfs returned:\n"
 467                     .Dumper([map [@$_], @orfs]);
 468
 469         is_deeply( $orfs->[0],
 470                    (sort {$b->[2] <=> $a->[2]} @$orfs)[0],
 471                    'orfs are sorted by descending length'
 472                   );
 473
 474         # make sure we get the same sequence by taking the longest orf
 475         # nucleotide from the test data and translating it, as by
 476         # calling translate with -orf => 'longest'
 477         is(
 478             Bio::PrimarySeq
 479               ->new( -seq => $test_seq, -id => 'fake_id' )
 480               ->translate( -orf => 'longest' )
 481               ->seq,
 482
 483             Bio::PrimarySeq
 484               ->new( -seq => substr( $test_seq, $orfs->[0][0], $orfs->[0][2] ),
 485                      -id => 'foo'
 486                     )
 487               ->translate
 488               ->seq,
 489             'got correct -orf => "longest" seq',
 490            );
 491     }
 492 }
 493
 494 #####
 495 # Extensive location and subsequence tests
 496 ok $seq = Bio::PrimarySeq->new('-seq' => 'AAAAACCCCCGGGGGTTTTT',);
 497 ok $seq->is_circular(1);
 498
 499 # NOTE: "_no_strand" variables tests the possibility that the user didn't set
 500 # Strand for positive coordinates (or the object comes from
 501 # Bio::Factory::FTLocationFactory->from_string)
 502
 503 # Single location
 504 # Coordinates: 1..5 => AAAAA
 505 # Revcom: complement(1..5) => TTTTT
 506 ok my $loc1_strand    = Bio::Location::Simple->new('-start' => 1, '-end' => 5,'-strand' => 1);
 507 ok my $loc1_no_strand = Bio::Location::Simple->new('-start' => 1, '-end' => 5);
 508 is $seq->subseq($loc1_strand),    'AAAAA';
 509 is $seq->subseq($loc1_no_strand), 'AAAAA';
 510 is $loc1_strand->to_FTstring,     '1..5';
 511 is $loc1_no_strand->to_FTstring,  '1..5';
 512 $loc1_strand->flip_strand;
 513 $loc1_no_strand->flip_strand;
 514 is $seq->subseq($loc1_strand),    'TTTTT';
 515 is $seq->subseq($loc1_no_strand), 'TTTTT';
 516 is $loc1_strand->to_FTstring,     'complement(1..5)';
 517 is $loc1_no_strand->to_FTstring,  'complement(1..5)';
 518 is $loc1_strand->length,    5;
 519 is $loc1_no_strand->length, 5;
 520
 521 # Basic split, both locations in positive strand
 522 # Coords: join(6..10,16..20) => CCCCCTTTTT
 523 # Revcom: complement(join(6..10,16..20)) => AAAAAGGGGG
 524 ok my $loc2_strand    = Bio::Location::Split->new();
 525 ok my $loc2_no_strand = Bio::Location::Split->new();
 526 ok $loc2_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 6,  '-end' => 10, '-strand' => 1) );
 527 ok $loc2_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 16, '-end' => 20, '-strand' => 1) );
 528 ok $loc2_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 6,  '-end' => 10) );
 529 ok $loc2_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 16, '-end' => 20) );
 530 is $seq->subseq($loc2_strand),    'CCCCCTTTTT';
 531 is $seq->subseq($loc2_no_strand), 'CCCCCTTTTT';
 532 is $loc2_strand->to_FTstring,     'join(6..10,16..20)';
 533 is $loc2_no_strand->to_FTstring,  'join(6..10,16..20)';
 534 $loc2_strand->flip_strand;
 535 $loc2_no_strand->flip_strand;
 536 is $seq->subseq($loc2_strand),    'AAAAAGGGGG';
 537 is $seq->subseq($loc2_no_strand), 'AAAAAGGGGG';
 538 is $loc2_strand->to_FTstring,     'complement(join(6..10,16..20))';
 539 is $loc2_no_strand->to_FTstring,  'complement(join(6..10,16..20))';
 540 is $loc2_strand->length,    15;
 541 is $loc2_no_strand->length, 15;
 542
 543 # Basic split, both locations in negative strand
 544 # Coords: complement(join(6..10,16..20)) => AAAAAGGGGG
 545 # Revcom: join(6..10,16..20) => CCCCCTTTTT
 546 my $loc3_strand    = Bio::Location::Split->new();
 547 $loc3_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 6,  '-end' => 10, '-strand' => -1) );
 548 $loc3_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 16, '-end' => 20, '-strand' => -1) );
 549 is $seq->subseq($loc3_strand),    'AAAAAGGGGG';
 550 is $loc3_strand->to_FTstring,     'complement(join(6..10,16..20))';
 551 $loc3_strand->flip_strand;
 552 is $seq->subseq($loc3_strand),    'CCCCCTTTTT';
 553 is $loc3_strand->to_FTstring,     'join(6..10,16..20)';
 554 is $loc3_strand->length, 15;
 555
 556 ## Cut by origin-split, same strand, single sequence that pass through origin
 557 #Coords: join(16..20,1..2) => TTTTTAA
 558 #Revcom: complement(join(16..20,1..2)) => TTAAAAA
 559 my $loc4_strand    = Bio::Location::Split->new();
 560 my $loc4_no_strand = Bio::Location::Split->new();
 561 $loc4_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 16, '-end' => 20, '-strand' => 1) );
 562 $loc4_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 1,  '-end' => 2,  '-strand' => 1) );
 563 $loc4_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 16, '-end' => 20) );
 564 $loc4_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 1,  '-end' => 2)  );
 565 is $seq->subseq($loc4_strand),    'TTTTTAA';
 566 is $seq->subseq($loc4_no_strand), 'TTTTTAA';
 567 is $loc4_strand->to_FTstring,     'join(16..20,1..2)';
 568 is $loc4_no_strand->to_FTstring,  'join(16..20,1..2)';
 569 $loc4_strand->flip_strand;
 570 $loc4_no_strand->flip_strand;
 571 is $seq->subseq($loc4_strand),    'TTAAAAA';
 572 is $seq->subseq($loc4_no_strand), 'TTAAAAA';
 573 is $loc4_strand->to_FTstring,     'complement(join(16..20,1..2))';
 574 is $loc4_no_strand->to_FTstring,  'complement(join(16..20,1..2))';
 575 is $loc4_strand->length,    7;
 576 is $loc4_no_strand->length, 7;
 577
 578 ## Cut by origin-combo split, same strand, 2 sequences with 1st passing through origin
 579 #Coords: join(19..20,1..2,11..13) => TTAAGGG
 580 #Revcom: complement(join(19..20,1..2,11..13)) => CCCTTAA
 581 my $loc5_strand    = Bio::Location::Split->new();
 582 my $loc5_no_strand = Bio::Location::Split->new();
 583 $loc5_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 19, '-end' => 20, '-strand' => 1) );
 584 $loc5_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 1,  '-end' => 2,  '-strand' => 1) );
 585 $loc5_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 11, '-end' => 13, '-strand' => 1) );
 586 $loc5_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 19, '-end' => 20) );
 587 $loc5_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 1,  '-end' => 2)  );
 588 $loc5_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 11, '-end' => 13) );
 589 is $seq->subseq($loc5_strand),    'TTAAGGG';
 590 is $seq->subseq($loc5_no_strand), 'TTAAGGG';
 591 is $loc5_strand->to_FTstring,     'join(19..20,1..2,11..13)';
 592 is $loc5_no_strand->to_FTstring,  'join(19..20,1..2,11..13)';
 593 $loc5_strand->flip_strand;
 594 $loc5_no_strand->flip_strand;
 595 is $seq->subseq($loc5_strand),    'CCCTTAA';
 596 is $seq->subseq($loc5_no_strand), 'CCCTTAA';
 597 is $loc5_strand->to_FTstring,     'complement(join(19..20,1..2,11..13))';
 598 is $loc5_no_strand->to_FTstring,  'complement(join(19..20,1..2,11..13))';
 599 is $loc5_strand->length,    15;
 600 is $loc5_no_strand->length, 15;
 601
 602 ## Cut by origin-combo split, same strand, 2 sequences with 2nd passing through origin
 603 #Coords: join(6..10,19..20,1..4) => CCCCCTTAAAA
 604 #Revcom: complement(join(6..10,19..20,1..4)) => TTTTAAGGGGG
 605 my $loc6_strand    = Bio::Location::Split->new();
 606 my $loc6_no_strand = Bio::Location::Split->new();
 607 $loc6_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 6,  '-end' => 10, '-strand' => 1) );
 608 $loc6_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 19, '-end' => 20, '-strand' => 1) );
 609 $loc6_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 1,  '-end' => 4,  '-strand' => 1) );
 610 $loc6_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 6,  '-end' => 10) );
 611 $loc6_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 19, '-end' => 20) );
 612 $loc6_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 1,  '-end' => 4)  );
 613 is $seq->subseq($loc6_strand),    'CCCCCTTAAAA';
 614 is $seq->subseq($loc6_no_strand), 'CCCCCTTAAAA';
 615 is $loc6_strand->to_FTstring,     'join(6..10,19..20,1..4)';
 616 is $loc6_no_strand->to_FTstring,  'join(6..10,19..20,1..4)';
 617 $loc6_strand->flip_strand;
 618 $loc6_no_strand->flip_strand;
 619 is $seq->subseq($loc6_strand),    'TTTTAAGGGGG';
 620 is $seq->subseq($loc6_no_strand), 'TTTTAAGGGGG';
 621 is $loc6_strand->to_FTstring,     'complement(join(6..10,19..20,1..4))';
 622 is $loc6_no_strand->to_FTstring,  'complement(join(6..10,19..20,1..4))';
 623 is $loc6_strand->length,    19;
 624 is $loc6_no_strand->length, 19;
 625
 626 ## Trans-splicing, 2 sequences in different strands, 2nd in complement
 627 #Coords: join(6..10,complement(16..20)) => CCCCCAAAAA
 628 #Revcom: join(16..20,complement(6..10)) => TTTTTGGGGG
 629 my $loc7_strand    = Bio::Location::Split->new();
 630 my $loc7_no_strand = Bio::Location::Split->new();
 631 $loc7_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 6,  '-end' => 10, '-strand' =>  1) );
 632 $loc7_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 16, '-end' => 20, '-strand' => -1) );
 633 $loc7_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 6,  '-end' => 10) );
 634 $loc7_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 16, '-end' => 20, '-strand' => -1) );
 635 is $seq->subseq($loc7_strand),    'CCCCCAAAAA';
 636 is $seq->subseq($loc7_no_strand), 'CCCCCAAAAA';
 637 is $loc7_strand->to_FTstring,     'join(6..10,complement(16..20))';
 638 is $loc7_no_strand->to_FTstring,  'join(6..10,complement(16..20))';
 639 $loc7_strand->flip_strand;
 640 $loc7_no_strand->flip_strand;
 641 is $seq->subseq($loc7_strand),    'TTTTTGGGGG';
 642 is $seq->subseq($loc7_no_strand), 'TTTTTGGGGG';
 643 is $loc7_strand->to_FTstring,     'join(16..20,complement(6..10))';
 644 is $loc7_no_strand->to_FTstring,  'join(16..20,complement(6..10))';
 645 is $loc7_strand->length,    10;
 646 is $loc7_no_strand->length, 10;
 647
 648 ## Trans-splicing, 2 sequences in different strands, 1st in complement
 649 #Coords: join(complement(16..20),6..10) => AAAAACCCCC
 650 #Revcom: join(complement(6..10),16..20) => GGGGGTTTTT
 651 my $loc8_strand    = Bio::Location::Split->new();
 652 my $loc8_no_strand = Bio::Location::Split->new();
 653 $loc8_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 16, '-end' => 20, '-strand' => -1) );
 654 $loc8_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 6,  '-end' => 10, '-strand' =>  1) );
 655 $loc8_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 16, '-end' => 20, '-strand' => -1) );
 656 $loc8_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 6,  '-end' => 10) );
 657 is $seq->subseq($loc8_strand),    'AAAAACCCCC';
 658 is $seq->subseq($loc8_no_strand), 'AAAAACCCCC';
 659 is $loc8_strand->to_FTstring,     'join(complement(16..20),6..10)';
 660 is $loc8_no_strand->to_FTstring,  'join(complement(16..20),6..10)';
 661 $loc8_strand->flip_strand;
 662 $loc8_no_strand->flip_strand;
 663 is $seq->subseq($loc8_strand),    'GGGGGTTTTT';
 664 is $seq->subseq($loc8_no_strand), 'GGGGGTTTTT';
 665 is $loc8_strand->to_FTstring,     'join(complement(6..10),16..20)';
 666 is $loc8_no_strand->to_FTstring,  'join(complement(6..10),16..20)';
 667 is $loc8_strand->length,    10;
 668 is $loc8_no_strand->length, 10;
 669
 670 ## Trans-splicing w/cut by origin, 2 sequences with 1st passing through origin, 2nd in complement
 671 #Coords: join(19..20,1..3,complement(11..13)) => TTAAACCC
 672 #Revcom: join(11..13,complement(1..3),complement(19..20)) => GGGTTTAA
 673 my $loc9_strand    = Bio::Location::Split->new();
 674 my $loc9_no_strand = Bio::Location::Split->new();
 675 $loc9_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 19, '-end' => 20, '-strand' =>  1) );
 676 $loc9_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 1,  '-end' => 3,  '-strand' =>  1) );
 677 $loc9_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 11, '-end' => 13, '-strand' => -1) );
 678 $loc9_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 19, '-end' => 20) );
 679 $loc9_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 1,  '-end' => 3)  );
 680 $loc9_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 11, '-end' => 13, '-strand' => -1) );
 681 is $seq->subseq($loc9_strand),    'TTAAACCC';
 682 is $seq->subseq($loc9_no_strand), 'TTAAACCC';
 683 is $loc9_strand->to_FTstring,     'join(19..20,1..3,complement(11..13))';
 684 is $loc9_no_strand->to_FTstring,  'join(19..20,1..3,complement(11..13))';
 685 $loc9_strand->flip_strand;
 686 $loc9_no_strand->flip_strand;
 687 is $seq->subseq($loc9_strand),    'GGGTTTAA';
 688 is $seq->subseq($loc9_no_strand), 'GGGTTTAA';
 689 is $loc9_strand->to_FTstring,     'join(11..13,complement(1..3),complement(19..20))';
 690 is $loc9_no_strand->to_FTstring,  'join(11..13,complement(1..3),complement(19..20))';
 691 is $loc9_strand->length,    8;
 692 is $loc9_no_strand->length, 8;
 693
 694 ## Trans-splicing w/cut by origin, 2 sequences with 1st passing through origin, 1st in complement
 695 #Coords: join(complement(1..3),complement(19..20),11..13) => TTTAAGGG
 696 #Revcom: join(complement(11..13),19..20,1..3) => CCCTTAAA
 697 my $loc10_strand    = Bio::Location::Split->new();
 698 my $loc10_no_strand = Bio::Location::Split->new();
 699 $loc10_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 1,  '-end' => 3,  '-strand' => -1) );
 700 $loc10_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 19, '-end' => 20, '-strand' => -1) );
 701 $loc10_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 11, '-end' => 13, '-strand' =>  1) );
 702 $loc10_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 1,  '-end' => 3,  '-strand' => -1) );
 703 $loc10_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 19, '-end' => 20, '-strand' => -1) );
 704 $loc10_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 11, '-end' => 13) );
 705 is $seq->subseq($loc10_strand),    'TTTAAGGG';
 706 is $seq->subseq($loc10_no_strand), 'TTTAAGGG';
 707 is $loc10_strand->to_FTstring,     'join(complement(1..3),complement(19..20),11..13)';
 708 is $loc10_no_strand->to_FTstring,  'join(complement(1..3),complement(19..20),11..13)';
 709 $loc10_strand->flip_strand;
 710 $loc10_no_strand->flip_strand;
 711 is $seq->subseq($loc10_strand),    'CCCTTAAA';
 712 is $seq->subseq($loc10_no_strand), 'CCCTTAAA';
 713 is $loc10_strand->to_FTstring,     'join(complement(11..13),19..20,1..3)';
 714 is $loc10_no_strand->to_FTstring,  'join(complement(11..13),19..20,1..3)';
 715 is $loc10_strand->length,    8;
 716 is $loc10_no_strand->length, 8;
 717
 718 ## Trans-splicing w/cut by origin, 2 sequences with 2nd passing through origin, 2nd in complement
 719 #Coords: join(6..10,complement(1..2),complement(18..20)) => CCCCCTTAAA
 720 #Revcom: join(18..20,1..2,complement(6..10)) => TTTAAGGGGG
 721 my $loc11_strand    = Bio::Location::Split->new();
 722 my $loc11_no_strand = Bio::Location::Split->new();
 723 $loc11_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 6,  '-end' => 10, '-strand' =>  1) );
 724 $loc11_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 1,  '-end' => 2,  '-strand' => -1) );
 725 $loc11_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 18, '-end' => 20, '-strand' => -1) );
 726 $loc11_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 6,  '-end' => 10) );
 727 $loc11_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 1,  '-end' => 2,  '-strand' => -1) );
 728 $loc11_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 18, '-end' => 20, '-strand' => -1) );
 729 is $seq->subseq($loc11_strand),    'CCCCCTTAAA';
 730 is $seq->subseq($loc11_no_strand), 'CCCCCTTAAA';
 731 is $loc11_strand->to_FTstring,     'join(6..10,complement(1..2),complement(18..20))';
 732 is $loc11_no_strand->to_FTstring,  'join(6..10,complement(1..2),complement(18..20))';
 733 $loc11_strand->flip_strand;
 734 $loc11_no_strand->flip_strand;
 735 is $seq->subseq($loc11_strand),    'TTTAAGGGGG';
 736 is $seq->subseq($loc11_no_strand), 'TTTAAGGGGG';
 737 is $loc11_strand->to_FTstring,     'join(18..20,1..2,complement(6..10))';
 738 is $loc11_no_strand->to_FTstring,  'join(18..20,1..2,complement(6..10))';
 739 is $loc11_strand->length,    10;
 740 is $loc11_no_strand->length, 10;
 741
 742 ## Trans-splicing w/cut by origin, 2 sequences with 2nd passing through origin, 1st in complement
 743 #Coords: join(complement(6..10),18..20,1..2) => GGGGGTTTAA
 744 #Revcom: join(complement(1..2),complement(18..20),6..10) => TTAAACCCCC
 745 my $loc12_strand    = Bio::Location::Split->new();
 746 my $loc12_no_strand = Bio::Location::Split->new();
 747 $loc12_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 6,  '-end' => 10, '-strand' => -1) );
 748 $loc12_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 18, '-end' => 20, '-strand' =>  1) );
 749 $loc12_strand->add_sub_Location(    Bio::Location::Simple->new('-start'  => 1,  '-end' => 2,  '-strand' =>  1) );
 750 $loc12_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 6,  '-end' => 10, '-strand' => -1) );
 751 $loc12_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 18, '-end' => 20) );
 752 $loc12_no_strand->add_sub_Location( Bio::Location::Simple->new('-start'  => 1,  '-end' => 2)  );
 753 is $seq->subseq($loc12_strand),    'GGGGGTTTAA';
 754 is $seq->subseq($loc12_no_strand), 'GGGGGTTTAA';
 755 is $loc12_strand->to_FTstring,     'join(complement(6..10),18..20,1..2)';
 756 is $loc12_no_strand->to_FTstring,  'join(complement(6..10),18..20,1..2)';
 757 $loc12_strand->flip_strand;
 758 $loc12_no_strand->flip_strand;
 759 is $seq->subseq($loc12_strand),    'TTAAACCCCC';
 760 is $seq->subseq($loc12_no_strand), 'TTAAACCCCC';
 761 is $loc12_strand->to_FTstring,     'join(complement(1..2),complement(18..20),6..10)';
 762 is $loc12_no_strand->to_FTstring,  'join(complement(1..2),complement(18..20),6..10)';
 763 is $loc12_strand->length,    10;
 764 is $loc12_no_strand->length, 10;