The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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' );
}