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;