package tests::TestHashConfigTest;
use strict;
use base qw/Lire::Test::TestCase/;
use Lire::Config;
use Lire::Config::TypeSpec;
use Lire::Test::HashConfig;
sub set_up {
# We do not link to SUPER which uses Lire::Test::HashConfig
my $self = $_[0];
$self->{'cfg_struct'} = { 'dir' => '/etc/',
'file' => '/etc/passwd',
'list_1' => [ 1..3 ],
'hash_1' => { a => 'b',
'b' => 'c', },
};
$self->{'cfg'} = new Lire::Test::HashConfig( $self->{'cfg_struct'} );
$self->{'spec'} = new Lire::Config::ConfigSpec( 'name' => 'mock' );
$self->{'spec'}->add( new Lire::Config::StringSpec( 'name' => 'string'));
$self->{'spec'}->add( new Lire::Config::IntegerSpec( 'name' => 'int') );
return;
}
sub tear_down {
my $self = $_[0];
return;
}
sub test_new {
my $self = $_[0];
my $cfg = $self->{'cfg'};
$self->assert_not_null( $cfg, "new() returned undef" );
$self->assert( UNIVERSAL::isa( $cfg, "Lire::Config" ),
"$cfg isn't a Lire::Config object" );
}
sub test_get {
my $self = $_[0];
my $cfg = $self->{'cfg'};
my $cfg_struct = $self->{'cfg_struct'};
foreach my $var_name ( keys %$cfg_struct ) {
my $value = $cfg->get( $var_name );
$self->assert_not_null( $value, "get( $var_name ) returned undef" );
$self->assert_equals( $value, $cfg_struct->{$var_name} );
}
$self->assert_died( sub { $cfg->get( 'unknown' ) },
qr/No such configuration variable/ );
$cfg->{'string'} =
$self->{'spec'}->get( 'string' )->instance( 'value' => 'A value' );
$self->assert_equals( 'A value', $cfg->get( 'string' ) );
}
sub test_Lire_Config_get {
my $self = $_[0];
local $Lire::Config::SINGLETON = $self->{'cfg'};
my $cfg_struct = $self->{'cfg_struct'};
foreach my $var_name ( keys %$cfg_struct ) {
my $value = Lire::Config->get( $var_name );
$self->assert_not_null( $value, "get( $var_name ) returned undef" );
$self->assert_equals( $value, $cfg_struct->{$var_name} );
}
}
sub test_unimplemented_methods {
my $self = $_[0];
my $cfg = $self->{'cfg'};
foreach my $method ( qw/config_spec_path
add_config_spec_path_dir del_config_spec_path_dir
config_files add_config_path
add_config_file del_config_file get_config_file / )
{
no strict 'refs';
eval { $cfg->$method() };
$self->assert( $@, "method $method() didn't failed" );
$self->assert( $@ =~ /Unimplemented method/,
"expected 'Unimplemented method' error, got '$@'" );
}
}
sub test_config_spec {
my $self = $_[0];
my $cfg = $self->{'cfg'};
$self->assert_died( sub { $cfg->config_spec() },
qr/attribute '_lr_config_spec' is undef/ );
my $spec = new Lire::Config::ConfigSpec( 'name' => 'mock' );
$cfg->{'_lr_config_spec'} = $spec;
$self->assert_str_equals( $spec, $cfg->config_spec() );
}
sub test_get_var {
my $self = $_[0];
my $cfg = $self->{'cfg'};
$cfg->{'string'} = 'A value';
$cfg->{'int'} = $self->{'spec'}->get( 'int' )->instance( 'value' => 10 );
$self->assert_died( sub { $cfg->get_var( 'string' ) },
qr/'string' isn't a Lire::Config::Value object and '_lr_config_spec' isn't set/ );
$self->assert_str_equals( $cfg->{'int'},
$cfg->get_var( 'int' ) );
$cfg->{'_lr_config_spec'} = $self->{'spec'};
my $var = $cfg->get_var( 'string' );
$self->assert( UNIVERSAL::isa( $var, 'Lire::Config::Scalar' ),
"expected a Lire::Config::Scalar, $var" );
$self->assert_str_equals( 'A value', $var->get() );
}
1;
syntax highlighted by Code2HTML, v. 0.9.1