#!/usr/bin/perl -w
######################################################
#
# $Id: matrix_charactersblock-interleave.t,v 1.7 2009/08/13 20:48:11 astoltzfus Exp $
# $Revision: 1.7 $
#
# Initial version by Gopalan Vivek (gopalan@umbi.umd.edu)
# Reference : http://www.perl.com/pub/a/2004/05/07/testing.html?page=2
# Date : 2nd November 2006
use strict;
use warnings;
use Test::More 'no_plan';
use lib 'lib';
use Bio::NEXUS;
use Data::Dumper;
####################################
# Test the interleave sub-command in the FORMAT command in CHARACTERS or DATA Block
######################################
my ( $nexus, $blocks, $character_block, $taxa_block, $tree_block );
# first file has chars block, second file (from Aaron Mackey) has deprecated data block format
my %tests = (
'file_name' => ["t/data/compliant/characters-block-interleave.nex", "t/data/compliant/HCRT_all_orths_pep1_msfed1.aln.nxs"],
'block_count' => [ 2, 2 ],
'otu_name' => ['A','Homo_sapiens'],
'char_count' => [ 59, 124 ]
);
my $i;
for ( $i = 0; $i < 2; $i++ ) {
my $file_name = $tests{'file_name'}[$i];
my $block_count = $tests{'block_count'}[$i];
my $otu_name = $tests{'otu_name'}[$i];
my $char_count = $tests{'char_count'}[$i];
printf( "\nTesting interleaved file '$file_name' (expect $char_count chars from OTU '$otu_name')\n" );
eval {
$nexus = new Bio::NEXUS($file_name);
$blocks = $nexus->get_blocks;
$character_block = $nexus->get_block("Characters");
};
# Check whether the files are read successfully
is( $@, '', 'Parsing nexus files' );
isa_ok( $nexus, 'Bio::NEXUS', 'NEXUS object defined' );
# Check for all the blocks
# Note that, when a file in the deprecated data-block format is parsed,
# this creates both a Characters block and a Taxa block
is( @{$blocks}, $block_count, "$block_count blocks are present" );
isa_ok( $character_block, "Bio::NEXUS::CharactersBlock",'Bio::NEXUS::CharactersBlock object present' );
my $seq_array_hash = $character_block->get_otuset->get_seq_array_hash;
my $chars = $seq_array_hash->{ $otu_name };
is( @{$chars}, $char_count, "$char_count characters are present in '$otu_name'" );
}
exit;