use Test::More tests => 19; use Test::Output; my $class = 'ConfigReader::Simple'; use_ok( $class ); my @Directives = qw( Test1 Test2 Test3 Test4 ); my $config = $class->new( "t/example.config", \@Directives ); isa_ok( $config, $class ); # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # set things that do exist foreach my $pair ( [ qw(Test1 Foo)] , [ qw(Pagagena Papageno) ], [ qw(Tamino Pamina) ] ) { my $key = $pair->[0]; my $value = $pair->[1]; $config->set( $key, $value ); is( $config->get( $key ), $value, "$key has the right value with get" ); is( $config->$key, $value, "$key has the right value with autoload" ); } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Setting things to references should fail: With $Die set { no warnings 'once'; local $ConfigReader::Simple::Die = 1; my $config = $class->new; isa_ok( $config, $class ); my $rc = eval { $class->set( 'Cat', \ 'Buster' ) }; my $at = $@; ok( length $at, '$@ is set while trying to set with a scalar reference' ); like( $at, qr/must be a simple scalar/ ); } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Setting things to references should fail: With $Die not set, $Warn set { no warnings 'once'; local $ConfigReader::Simple::Die = undef; local $ConfigReader::Simple::Warn = 1; local $SIG{__WARN__} = sub { print STDERR @_ }; my $config = $class->new; isa_ok( $config, $class ); stderr_like { $class->set( 'Cat', \ 'Buster' ) } qr/must be a simple scalar/, 'set complains when $Warn is set and given a reference'; } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Setting things to references should fail: With $Die not set, $Warn not set { no warnings 'once'; local $ConfigReader::Simple::Die = undef; local $ConfigReader::Simple::Warn = undef; local $SIG{__WARN__} = sub { print STDERR @_ }; my $config = $class->new; isa_ok( $config, $class ); stderr_like { $class->set( 'Cat', \ 'Buster' ) } qr/^$/, 'set silent when $Warn, $Die are unset and given a reference'; } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # unset things that do exist { my $directive = 'Test2'; ok( $config->unset( $directive ), "Unset thing that exists [$directive]" ); my $not_defined = not defined $config->$directive; ok( $not_defined, "Unset thing [$directive] still has value" ); } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # unset things that do not exist { my $directive = 'Tenor'; my $value = not $config->unset( $directive ); ok( $value, 'Unset thing that does not exist [$directive]' ); $value = not $config->exists( $directive ); ok( $value, 'Unset thing that did not exist [$directive] exists' ); }