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, "<param name=\"$name\"" );
$self->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, "<lrcml:param name=\"$name\"" );
$self->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;
syntax highlighted by Code2HTML, v. 0.9.1