The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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");