t/AlignIO/nexml.t

   1 #-*-perl-*-
   2 # $Id$
   3 use strict;
   4
   5 use Bio::Root::Test;
   6 test_begin(-tests => 125,  -requires_modules => [qw(Bio::Phylo)]);
   7 use_ok('Bio::AlignIO::nexml'); # checks that your module is there and loads ok
   8 diag("WARNING: NeXML parsing for NeXML v0.9 is currently very experimental support");
   9 SKIP: {
  10     skip("NeXML parsing for NeXML v0.9 is currently very experimental support", 124);
  11
  12     #Read in Data
  13     ok( my $inAlnStream = Bio::AlignIO->new(-file => test_input_file("nexml","characters.nexml.xml"),
  14                                             -format => 'nexml'), 'make stream');
  15
  16     #Read in aln objects
  17     ok( my $aln_obj = $inAlnStream->next_aln(), 'nexml matrix to aln' );
  18     isa_ok($aln_obj, 'Bio::SimpleAlign', 'obj ok');
  19     is ($aln_obj->id,   'DNA sequences', 'aln id');
  20     my $num =0;
  21     my @expected_seqs = ('ACGCTCGCATCGCATC', 'ACGCTCGCATCGCATC', 'ACGCTCGCATCGCATC');
  22     #checking sequence objects
  23     foreach my $seq_obj ($aln_obj->each_seq()) {
  24         $num++;
  25
  26         is( $seq_obj->alphabet, 'dna', "alphabet" );
  27
  28         TODO: {
  29             local $TODO = 'primary/display_id broken with NeXML 0.9';
  30             is( $seq_obj->display_id, "DNA sequences.row_$num", "display_id");
  31         }
  32         is( $seq_obj->seq, $expected_seqs[$num-1], "sequence correct");
  33     }
  34
  35     #Write Data
  36     diag('Begin tests for write/read roundtrip');
  37     my $outdata = test_output_file();
  38     ok( my $outAlnStream = Bio::AlignIO->new(-file => ">$outdata", -format => 'nexml'), 'out stream ok');;
  39     ok( $outAlnStream->write_aln($aln_obj), 'write nexml');
  40     close($outdata);
  41
  42
  43     #Read in the written file to test roundtrip
  44     ok( my $inAlnStream2 = Bio::AlignIO->new(-file => $outdata, -format => 'nexml'), 'reopen');
  45
  46     #Read in aln objects
  47     ok( my $aln_obj2 = $inAlnStream2->next_aln(),'get aln (rt)' );
  48     isa_ok($aln_obj2, 'Bio::SimpleAlign', 'aln obj (rt)');
  49     is ($aln_obj2->id, 'DNA sequences', "aln id (rt)");
  50     $num =0;
  51     @expected_seqs = ('ACGCTCGCATCGCATC', 'ACGCTCGCATCGCATC', 'ACGCTCGCATCGCATC');
  52     #checking sequence objects
  53     foreach my $seq_obj ($aln_obj2->each_seq()) {
  54         $num++;
  55
  56         is( $seq_obj->alphabet, 'dna', "alphabet (rt)" );
  57         is( $seq_obj->display_id, "DNA sequences.row_$num", "display_id (rt)");
  58         is( $seq_obj->seq, $expected_seqs[$num-1], "sequence (rt)");
  59     }
  60     #check taxa object
  61     my %expected_taxa = ('DNA sequences.row_1' => 'Homo sapiens',
  62                          'DNA sequences.row_2' => 'Pan paniscus',
  63                          'DNA sequences.row_3' => 'Pan troglodytes');
  64     my @feats = $aln_obj2->get_all_SeqFeatures();
  65     foreach my $feat (@feats) {
  66         if ($feat->has_tag('taxa_id')){
  67             is ( ($feat->get_tag_values('taxa_id'))[0], 'taxa1', 'taxa id ok' );
  68             is ( ($feat->get_tag_values('taxa_label'))[0], 'Primary taxa block', 'taxa label ok');
  69             is ( $feat->get_tag_values('taxon'), 5, 'Number of taxa ok')
  70         }
  71         else{
  72             my $seq_num = ($feat->get_tag_values('id'))[0];
  73             is ( ($feat->get_tag_values('taxon'))[0], $expected_taxa{$seq_num}, "$seq_num taxon ok" )
  74         }
  75     }
  76 }