package tests::ConfigValuesTest; use strict; use base qw/Test::Unit::TestSuite/; use Lire::Config::TypeSpec; use Lire::Config::Value; use IO::Scalar; sub name { return "Configuration Values Tests"; } sub include_tests { return qw/tests::ConfigScalarTest tests::ConfigListTest tests::ConfigDictionaryTest /; } package tests::ConfigValueTest; use base qw/Lire::Test::TestCase/; sub new { my $self = shift->SUPER::new( @_ ); $self->{'config_spec'} = new Lire::Config::ConfigSpec(); $self->{'list_spec'} = new Lire::Config::ListSpec( 'name' => "list" ); $self->{'config_spec'}->add( $self->{'list_spec'} ); $self->{'int_spec'} = new Lire::Config::IntegerSpec( 'name' => "int" ); $self->{'config_spec'}->add( $self->{'int_spec'} ); $self->{'string_spec'} = new Lire::Config::StringSpec( 'name' => "string" ); $self->{'config_spec'}->add( $self->{'string_spec'} ); $self->{'list_spec'}->add( $self->{'int_spec'} ); $self->{'select_spec'} = new Lire::Config::SelectSpec( 'name' => "select" ); $self->{'config_spec'}->add( $self->{'select_spec'} ); $self->{'list_spec'}->add( $self->{'select_spec'} ); $self->{'select_spec'}->add( new Lire::Config::OptionSpec( 'name' => "option_1" )); $self->{'select_spec'}->add( new Lire::Config::OptionSpec( 'name' => "option_2" )); return $self; } sub test_new { my $self = $_[0]; my $value = $self->type()->new( 'spec' => $self->spec() ); $self->assert_isa( $self->type(), $value ); $self->assert_str_equals( $self->spec()->name(), $value->name() ); my $proto = $value->new(); $self->assert_isa( $self->type(), $proto ); $self->assert_str_not_equals( $proto, $value ); $self->assert_deep_equals( $proto, $value ); $self->assert_dies( qr/missing 'spec' parameter/, sub { $self->type()->new() } ); $self->assert_dies( qr/'spec' parameter.*should be a.*instance/, sub { $self->type()->new( 'spec' => $self ) } ); } sub test_as_shell_var { my $self = $_[0]; my $value = $self->type()->new( 'spec' => $self->spec() ); my $name = $value->name(); $self->assert_matches( qr/$name=.*not supported/, $value->as_shell_var() ); } sub test_clone { my $self = $_[0]; my $value = $self->type()->new( 'spec' => $self->spec() ); my $clone = $value->clone(); $self->assert_str_not_equals( $value, $clone ); $self->assert_deep_equals( $value, $clone ); $self->assert_str_equals( $value->{'spec'}, $clone->{'spec'} ); } sub test_is_equals { my $self = $_[0]; my $value = $self->type()->new( 'spec' => $self->spec() ); $self->assert( $value->is_equals( $value ), 'is_equals( $self )' ); $self->assert( $value->is_equals( $value->clone() ), 'is_equals( clone )' ); # Changing the spec, should returns false. my $other_value = $value->clone(); $other_value->{'spec'} = {}; $self->assert( ! $value->is_equals( $other_value ), '! is_equals( other_spec )' ); } sub test_is_default { my $self = $_[0]; my $default = $self->spec()->instance(); $self->assert( ! $default->is_default(), "!is_default()" ); $self->spec()->default( $default ); my $value = $self->type()->new( 'spec' => $self->spec() ); $self->assert( $value->is_default(), "is_default() != 1" ); } sub check_save_xml_default { my ( $self, $value ) = @_; my $name = $self->spec()->name(); my $fh = new IO::Scalar(); my $buf = $fh->sref(); $value->save_xml( $fh ); my $pos = index( $$buf, "assert( $pos >= 0, $$buf || 'Nothing written' ); $self->spec()->default( $value ); my $default = $self->spec()->instance(); $$buf = ''; $default->save_xml( $fh ); $self->assert_str_equals( '', $$buf ); $self->spec()->default( undef ); } sub check_save_xml_obsolete { my ( $self, $value ) = @_; my $name = $self->spec()->name(); my $fh = new IO::Scalar(); my $buf = $fh->sref(); $self->spec()->obsolete( 1 ); $value->save_xml( $fh ); $self->assert_str_equals( '', $$buf ); $self->spec()->obsolete( 0 ); $value->save_xml( $fh, 0, 'lrcml:' ); my $pos = index( $$buf, "assert( $pos >= 0, $$buf || 'Nothing written' ); } sub test_save_xml { my $self = $_[0]; my $value = $self->spec()->instance(); $self->check_save_xml_default( $value->clone() ); $self->check_save_xml_obsolete( $value->clone() ); } package tests::ConfigScalarTest; use base qw/tests::ConfigValueTest/; sub type { return "Lire::Config::Scalar"; } sub spec { return $_[0]{'int_spec'}; } sub test_new { my $self = $_[0]; $self->SUPER::test_new; my $value = new Lire::Config::Scalar( 'spec' => $self->{'int_spec'}, 'value' => 10, ); $self->assert_equals( 10, $value->as_value() ); $self->assert_deep_equals( $value, $value->new() ); my $other = $value->new( 'value' => 11 ); $self->assert_num_equals( 11, $other->{'value'} ); } sub test_as_value { my $self = $_[0]; my $value = new Lire::Config::Scalar( 'spec' => $self->{'int_spec'} ); $value->set( 10 ); $self->assert_equals( 10, $value->as_value() ); $value = new Lire::Config::Scalar( 'spec' => $self->{'select_spec'} ); $value->set( "OPTION_1" ); $self->assert_equals( "OPTION_1", $value->get() ); $self->assert_equals( "option_1", $value->as_value() ); my $warning = ''; local $SIG{'__WARN__'} = sub { $warning .= join "", @_ }; $value = new Lire::Config::Scalar( 'spec' => $self->{'select_spec'} ); $value->{'value'} = "no_such_option"; my @array_context = $value->as_value(); $self->assert_matches( qr/invalid value for parameter 'select':/, $warning ); $self->assert_deep_equals( [], \@array_context ); # Second as_value() shouldn't emit another warning $warning = ''; $self->assert_null( scalar $value->as_value(), "should return undef in scalar context" ); $self->assert_equals( '', $warning ); } sub test_as_shell_var { my $self = $_[0]; my $int = $self->type->new( 'spec' => $self->{'int_spec'}, value => 10 ); $self->assert_equals( "int='10'", $int->as_shell_var() ); my $undefined_int = $self->type->new( 'spec' => $self->{'int_spec'} ); $self->assert_equals( "", $undefined_int->as_shell_var() ); my $s = q{> Long string with shell `metacharacters`, 'quote', "double"}; my $quoted = q{> Long string with shell `metacharacters`, '\''quote'\'', "double"}; my $string = $self->type->new( 'spec' => $self->{'string_spec'}, value => $s ); $self->assert_equals( "string='$quoted'", $string->as_shell_var() ); local $SIG{'__WARN__'} = sub { $self->annotate( join "", @_ ) }; my $bad_option = $self->type->new( 'spec' => $self->{'select_spec'}, 'value' => "bad_option" ); $self->assert_equals( '', $bad_option->as_shell_var() ); } sub test_set { my $self = $_[0]; my $value = new Lire::Config::Scalar( 'spec' => $self->{'int_spec'} ); $value->set( 10 ); $self->assert_equals( 10, $value->get() ); my $warning = undef; my $oldwarn = $SIG{'__WARN__'}; $SIG{'__WARN__'} = sub { $warning = join(' ', @_); }; $value->set('file'); $SIG{'__WARN__'} = $oldwarn; $self->assert_null($warning, "set() with invalid value should NOT warn"); } sub test_is_equals { my $self = $_[0]; $self->SUPER::test_is_equals(); my $string = new Lire::Config::Scalar( 'spec' => $self->{'string_spec'} ); my $other_string = $string->clone(); $string->{'value'} = 'A value'; my $int = new Lire::Config::Scalar( 'spec' => $self->{'int_spec'} ); my $other_int = $int->clone(); $int->{'value'} = 10; $self->assert( ! $string->is_equals( $other_string ), "! is_equals( undef )" ); $other_int->{'value'} = 11; $self->assert( ! $int->is_equals( $other_int ), "! is_equals( 11 )" ); $other_int->{'value'} = "10.0000"; $self->assert( $int->is_equals( $other_int ), "is_equals( 10.00 )" ); } package tests::ConfigListTest; use base qw/tests::ConfigValueTest/; sub type { return "Lire::Config::List"; } sub spec { return $_[0]{'list_spec'}; } sub test_new { my $self = $_[0]; $self->SUPER::test_new(); my $list = $self->{'list_spec'}->instance(); $list->append( $self->{'select_spec'}->instance() ); $self->assert_deep_equals( $list, $list->new() ); } sub test_as_value { my $self = $_[0]; local $SIG{'__WARN__'} = sub { $self->annotate( join "", @_ ) }; my $list = $self->{'list_spec'}->instance(); $self->assert_deep_equals( [], $list->as_value() ); $list->append( $self->{'int_spec'}->instance( 'value' => 10 ) ); $list->append( $self->{'select_spec'}->instance( 'value' => "option_1" ) ); $list->append( $self->{'select_spec'}->instance( 'value' => "no_such_option" ) ); $self->assert_deep_equals( [ 10, "option_1" ], $list->as_value(), ); } sub test_is_valid { my $self = $_[0]; my $list = $self->{'list_spec'}->instance(); $self->assert( $list->is_valid(), 'is_valid()' ); $list->append( $self->{'int_spec'}->instance( 'value' => 'abc' ) ); $self->assert( !$list->is_valid(), '!is_valid()' ); $list->get( 0 )->set( '10' ); $self->assert( $list->is_valid(), 'is_valid()' ); $list->append( $self->{'select_spec'}->instance( 'value' => "bad_option")); $self->assert( !$list->is_valid(), '!is_valid()' ); $list->get( 1 )->spec()->required( 0 ); $self->assert( $list->is_valid(), 'is_valid()' ); } sub test_get { my $self = $_[0]; my $list = $self->{'list_spec'}->instance(); $self->assert_dies( qr/index out of bounds/, sub { $list->get( 0 ) } ); my $int = $self->{'int_spec'}->instance( 'value' => 10 ); $list->append( $int ); $self->assert_equals( $int, $list->get( 0 ) ); $self->assert_equals( $int, $list->get( -1 ) ); $self->assert_dies( qr/'idx' parameter should be an integer/, sub { $list->get( "string" ) } ); } sub test_set { my $self = $_[0]; my $list = $self->{'list_spec'}->instance(); $self->assert_dies( qr/missing 'idx' parameter/, sub { $list->set() }); my $int = $self->{'int_spec'}->instance( 'value' => 10 ); $self->assert_dies( qr/index out of bounds: 0/, sub { $list->set( 0, $int ) } ); $list->append( $int ); $self->assert_dies( qr/missing 'value' parameter/, sub { $list->set( 0, undef ) } ); $int = $self->{'int_spec'}->instance( 'value' => 5 ); $list->set( 0, $int ); $self->assert_str_equals( $int, $list->{'elements'}[0] ); } sub test_append { my $self = $_[0]; my $list = $self->{'list_spec'}->instance(); $self->assert_equals( 0, scalar $list->elements() ); my $select = $self->{'select_spec'}->instance(); my $int = $self->{'int_spec'}->instance( 'value' => 10 ); $list->append( $select ); $self->assert_equals( 1, scalar $list->elements() ); $list->append( $int ); $self->assert_deep_equals( [ $select, $int ], [$list->elements()] ); $self->assert_dies( qr/missing 'value' parameter/, sub { $list->append() }); $self->assert_dies( qr/cannot contains config parameters/, sub { $list->append( $self->{'config_spec'}->instance() )}); my $bad_select = new Lire::Config::SelectSpec( 'name' => $self->{'select_spec'}->name ); $self->assert_dies( qr/is not a valid instance for component/, sub { $list->append( $bad_select->instance() ) } ); } sub test_check_idx { my $self = $_[0]; my $list = $self->{'list_spec'}->instance(); $self->assert_dies( qr/not an integer: wawa/, sub { $list->check_idx( 'wawa' ) } ); $self->assert_dies( qr/index out of bounds: 0/, sub { $list->check_idx( 0 ) } ); $self->assert_dies( qr/index out of bounds: -1/, sub { $list->check_idx( -1 ) } ); $list->{'elements'} = [ undef, undef, undef ]; foreach my $idx ( qw/ 0 1 2 -1 -2 -3/ ) { eval { $list->check_idx( $idx ) }; $self->fail( "$@" ) if $@; } } sub test_append_idx { my $self = $_[0]; my $list = $self->{'list_spec'}->instance(); my $int = $self->{'int_spec'}->instance( 'value' => 10 ); $list->{'elements'} = [ undef, undef ]; $list->append( $int, 0 ); $self->assert_deep_equals( [ undef, $int, undef ], $list->{'elements'} ); $list->append( $int, -1 ); $self->assert_deep_equals( [ undef, $int, undef, $int ], $list->{'elements'} ); } sub test_move { my $self = $_[0]; my $list = $self->{'list_spec'}->instance(); $list->{'elements'} = [ 0, 1, 2, 3, 4 ]; $list->move( 0, -1 ); $self->assert_deep_equals( [ 1, 2, 3, 4, 0 ], $list->{'elements'} ); $list->move( 1, 0 ); $self->assert_deep_equals( [ 2, 1, 3, 4, 0 ], $list->{'elements'} ); $list->move( 2, -2 ); $self->assert_deep_equals( [ 2, 1, 4, 3, 0 ], $list->{'elements'} ); $list->move( 0, 0 ); $self->assert_deep_equals( [ 2, 1, 4, 3, 0 ], $list->{'elements'} ); $list->move( 0, -5 ); $self->assert_deep_equals( [ 2, 1, 4, 3, 0 ], $list->{'elements'} ); $list->move( -5, -5 ); $self->assert_deep_equals( [ 2, 1, 4, 3, 0 ], $list->{'elements'} ); $list->move( -5, -4 ); $self->assert_deep_equals( [ 1, 2, 4, 3, 0 ], $list->{'elements'} ); } sub test_clear { my $self = $_[0]; my $list = $self->{'list_spec'}->instance(); $list->{'elements'} = [ 0, 1, 2, 3, 4 ]; $list->clear(); $self->assert_deep_equals( [], $list->{'elements'} ); } sub test_is_equals { my $self = $_[0]; $self->SUPER::test_is_equals(); my $list = $self->{'list_spec'}->instance(); my $other = $list->clone(); my $int = $self->{'int_spec'}->instance( 'value' => 10 ); $list->append( $int ); $self->assert( ! $list->is_equals( $other ), '! is_equals( count )' ); $other->append( $self->{'int_spec'}->instance( 'value' => 11 ) ); $self->assert( ! $list->is_equals( $other ), '! is_equals( different )' ); $other->set( 0, $int->clone() ); $self->assert( $list->is_equals( $other ), 'is_equals()' ); } package tests::ConfigDictionaryTest; use base qw/tests::ConfigValueTest/; sub type { return "Lire::Config::Dictionary"; } sub spec { return $_[0]{'config_spec'}; } sub test_new { my $self = $_[0]; $self->SUPER::test_new(); my $dict = $self->{'config_spec'}->instance(); $dict->set( $self->{'int_spec'}->instance() ); $self->assert_deep_equals( $dict, $dict->new() ); } sub test_as_value { my $self = $_[0]; local $SIG{'__WARN__'} = sub { $self->annotate( join "", $@ ) }; my $dict = $self->{'config_spec'}->instance(); $self->assert_deep_equals( { 'select' => undef, 'int' => 0, 'list' => [], 'string' => '', }, $dict->as_value, ); $dict->set( $self->{'select_spec'}->instance( 'value' => "option_1" ) ); $dict->set( $self->{'int_spec'}->instance( 'value' => "10" ) ); $self->assert_deep_equals( { 'select' => "option_1", 'int' => 10, 'list' => [], 'string' => '', }, $dict->as_value, ); } sub test_is_set { my $self = $_[0]; my $dict = $self->{'config_spec'}->instance(); $self->assert( !$dict->is_set( "int" ), "is_set() returned true" ); $dict->get( 'int' ); $self->assert( $dict->is_set( "int" ), "is_set() returned false" ); $self->assert_dies( qr/missing 'name' parameter/, sub { $dict->is_set() } ); ; $self->assert_dies( qr/no parameter no_such_param defined/, sub { $dict->is_set( "no_such_param") } ); } sub test_get { my $self = $_[0]; my $dict = $self->{'config_spec'}->instance(); my $int = $dict->get( "int" ); $self->assert_not_null( $int, "get() should create the instance" ); $self->assert_equals( "int", $int->name() ); $self->assert_str_equals( '', $int->get() ); $self->assert_equals( $int, $dict->get( "int" ) ); $self->assert_dies( qr/missing 'name' parameter/, sub { $dict->get() } ); $self->assert_dies( qr/no parameter bad_param defined in/, sub { $dict->get( "bad_param" ) } ); } sub test_set { my $self = $_[0]; my $dict = $self->{'config_spec'}->instance(); $self->assert_dies( qr/missing 'value' parameter/, sub { $dict->set() } ); $self->assert_dies( qr/\'value\' parameter should be a \'Lire::Config::Value\' instance, not/, sub{ $dict->set( $self->{'config_spec'} ) } ); my $int = $self->{'int_spec'}->instance(); $dict->set( $int ); $self->assert_equals( $int, $dict->get( 'int' ) ); my $select = new Lire::Config::SelectSpec( 'name' => 'int' )->instance(); ; $self->assert_dies( qr/is not a valid instance for parameter/, sub { $dict->set( $select ) } ); } sub test_is_equals { my $self = $_[0]; $self->SUPER::test_is_equals(); my $dict = $self->{'config_spec'}->instance(); my $other = $dict->clone(); $dict->set( $self->{'string_spec'}->instance( 'value' => 'A value' ) ); $self->assert( ! $dict->is_equals( $other ), "!is_equals()" ); $other->set( $self->{'string_spec'}->instance( 'value' => 'A value' ) ); $self->assert( $dict->is_equals( $other ), "is_equals()" ); } sub test_is_valid { my $self = $_[0]; my $cfg = $self->{'config_spec'}->instance(); $self->assert( !$cfg->is_valid(), '!is_valid()' ); $cfg->get( 'int' )->set( 10 ); $cfg->get( 'select' )->spec()->required( 0 ); $cfg->get( 'string' )->spec()->required( 0 ); $self->assert( $cfg->is_valid(), 'is_valid()' ); } 1;