#!/usr/bin/env perl ###################################################### # Author: Chengzhi Liang, Weigang Qiu, Peter Yang, Thomas Hladish, Brendan # $Id: assumptionsblock_options.t,v 1.10 2010/09/22 19:59:00 astoltzfus Exp $ # $Revision: 1.10 $ # Written by Mikhail Bezruchko, Vivek Gopalan, Arlin Stoltzfus # Refernce: http://www.perl.com/pub/a/2004/05/07/testing.html?page=2 # Date: 31 Jan 2007 use strict; use warnings; use Test::More 'no_plan'; use Bio::NEXUS; use Data::Dumper; ################################ # Testing 'Options' command # of Assumptions block. ################################ print "\n"; # methods/basic functions: # - read options: # a. read a nexus file # b. get the assump_block # c. assump_block->get_def_type() eq 'expected' # d. assump_block->...() eq 'expected' ... my $nex_obj; eval { $nex_obj = new Bio::NEXUS("t/data/compliant/02_assumptions-block_options_02.nex"); }; my $assump_block = $nex_obj->get_block("assumptions"); #print Dumper $assump_block; is ($@, '', "File parsed w/o errors"); print "--- get_option() ---\n"; is ($assump_block->get_option('deftype'), "unord", "deftype=unord"); is ($assump_block->get_option('gapmode'), "missing", "gapmode=missing"); is ($assump_block->get_option('polytcount'), undef, "polytcount is undefined"); is ($assump_block->get_option('unsupported_option'), undef, "no such option: unsupported_option: return undef"); print "--- set_option() ---\n"; $assump_block->set_option('deftype', 'Dollo'); $assump_block->set_option('gapmode', 'NewState'); $assump_block->set_option('random_opt', 'random_val'); is ($assump_block->get_option('deftype'), 'dollo', "deftype=dollo"); is ($assump_block->get_option('gapmode'), 'newstate', "gapmode=newstate"); is ($assump_block->get_option('polytcount'), undef, "polytcount is undefined"); is ($assump_block->get_option('random_opt'), 'random_val', "random_opt=random_val"); print "--- get_all_options() ---\n"; my $options = $assump_block->get_all_options(); print Dumper $options; my $options_expected = {'deftype' => 'dollo', 'gapmode' => 'newstate', 'random_opt' => 'random_val'}; is_deeply ($options, $options_expected, "structures are equal"); print "--- set_all_options() ---\n"; # note: is_deeply is case sensitive, so: make sure that # the expected values match observed AND the case matches too my $new_options = {'deftype' => 'unord', 'gapmode' => 'missing', 'random_opt' => ''}; $assump_block->set_all_options($new_options); my $options_got = $assump_block->get_all_options(); is_deeply($new_options, $options_got, "structures are equal"); #print Dumper $assump_block->get_all_options(); #print Dumper $options_got; print "Printing the assumption block\n"; $assump_block->_write(); $assump_block->{'options'} = {'deftype' => undef, 'gapmode' => 'missing'}; print "Deleting the options\n"; print Dumper $assump_block; print "Printing the assumption block\n"; $assump_block->_write(); # - write options should be tested ... somehow. # ... print "--- _validate_options() ---\n"; print "> set_option()\n"; $assump_block->set_option('DefType', 'spam'); print "> set_all_options()\n"; $assump_block->set_all_options({'deftype' => 'spam_spam', 'gapmode' => 'eggs', 'new_option' => 'some_val'}); print Dumper $assump_block->get_all_options(); print "--- testing another file ---\n"; $nex_obj = undef; eval { $nex_obj = new Bio::NEXUS("t/data/compliant/02_assumptions-block_options_01.nex"); }; $assump_block = $nex_obj->get_block("assumptions"); print Dumper $assump_block; is ($@, '', "File parsed w/o errors"); print "--- get_option() ---\n"; is ($assump_block->get_option('deftype'), "unord", "deftype=unord");