The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w

use strict;
use Test::More tests => 48;
use Test::Exception;

use Data::Util qw(:all);

use constant PP_ONLY => $INC{'Data/Util/PurePerl.pm'};

BEGIN{
	package Foo;
	sub new{
		bless {}, shift;
	}

	package MyArray;
	our @ISA = qw(Foo);
	use overload
		bool  => sub{ 1 },
		'@{}' => sub{  ['ARRAY'] },
	;
	package MyHash;
	our @ISA = qw(Foo);
	use overload
		bool  => sub{ 1 },
		'%{}' => sub{ +{ foo => 'ARRAY' } },
	;

	package BadHash;
		our @ISA = qw(Foo);
	use overload
		bool => sub{ 1 },
		'%{}' => sub{ ['ARRAY'] },
	;
}

use constant true  => 1;
use constant false => 0;

# mkopt

is_deeply mkopt(undef), [], 'mkopt()';

is_deeply mkopt([]), [];
is_deeply mkopt(['foo']), [ [foo => undef] ];
is_deeply mkopt([foo => undef]), [ [foo => undef] ];
is_deeply mkopt([foo => [42]]), [ [foo => [42]] ];
is_deeply mkopt([qw(foo bar baz)]), [ [foo => undef], [bar => undef], [baz => undef]];

is_deeply mkopt({foo => undef}), [ [foo => undef] ];
is_deeply mkopt({foo => [42]}),  [ [foo => [42]] ];

is_deeply mkopt([qw(foo bar baz)], undef, true), [[foo => undef], [bar => undef], [baz => undef]], 'unique';

is_deeply mkopt([foo => [], qw(bar)], undef, false, 'ARRAY'), [[foo => []], [bar => undef]], 'validation';
is_deeply mkopt([foo => [], qw(bar)], undef, false, ['CODE', 'ARRAY']), [[foo => []], [bar => undef]];
is_deeply mkopt([foo => anon_scalar], undef, false, 'SCALAR'), [[foo => anon_scalar]];
is_deeply mkopt([foo => \&ok],       undef, false, 'CODE'),   [[foo => \&ok]];
is_deeply mkopt([foo => Foo->new], undef, false, 'Foo'), [[foo => Foo->new]];

is_deeply mkopt(MyArray->new()), [ [ARRAY => undef] ], 'overloaded data (ARRAY)';

is_deeply mkopt([foo => [], qw(bar)], undef, false, {foo => 'ARRAY'}),   [[foo => []], [bar => undef]];
is_deeply mkopt([foo => [], bar => {}], undef, false, {foo => ['CODE', 'ARRAY'], bar => 'HASH'}), [[foo => []], [bar => {}]];

is_deeply mkopt([foo => [42]], undef, false, MyArray->new()), [[foo => [42]]], 'overloaded validator (ARRAY)';

is_deeply mkopt([foo => [42]], 'test', false, MyHash->new()),  [[foo => [42]]], 'overloaded validator (HASH)';
dies_ok{
	mkopt([foo => {}], 'test', false, MyHash->new());
};

# mkopt_hash

is_deeply mkopt_hash(undef), {}, 'mkopt_hash()';

is_deeply mkopt_hash([]), {};
is_deeply mkopt_hash(['foo']), { foo => undef };
is_deeply mkopt_hash([foo => undef]), { foo => undef };
is_deeply mkopt_hash([foo => [42]]), { foo => [42] };
is_deeply mkopt_hash([qw(foo bar baz)]), { foo => undef, bar => undef, baz => undef };

is_deeply mkopt_hash({foo => undef}), { foo => undef };
is_deeply mkopt_hash({foo => [42]}),  { foo => [42] };

is_deeply mkopt_hash([foo => [], qw(bar)], undef, 'ARRAY'), {foo => [], bar => undef}, 'validation';
is_deeply mkopt_hash([foo => [], qw(bar)], undef, ['CODE', 'ARRAY']), {foo => [], bar => undef};
is_deeply mkopt_hash([foo => Foo->new], undef, 'Foo'), {foo => Foo->new};

is_deeply mkopt_hash([foo => [], qw(bar)], undef, {foo => 'ARRAY'}),   {foo => [], bar => undef};
is_deeply mkopt_hash([foo => [], bar => {}], undef, {foo => ['CODE', 'ARRAY'], bar => 'HASH'}), {foo => [], bar => {}};

# XS specific misc. check
my $key = 'foo';
my $ref = mkopt([$key]);
$ref->[0][0] .= 'bar';
is $key, 'foo';
$ref = mkopt_hash([$key]);
$key .= 'bar';
is_deeply $ref, {foo => undef};

sub f{
	return mkopt(@_);
}

{
	my $a = mkopt(my $foo = ['foo']); push @$foo, 42;
	my $b = mkopt(my $bar = ['bar']); push @$bar, 42;
	is_deeply $a, [[foo => undef]], '(use TARG)';
	is_deeply $b, [[bar => undef]], '(use TARG)';
}
# unique
throws_ok{
	mkopt [qw(foo foo)], "mkopt", 1;
} qr/multiple definitions/i, 'unique-mkopt';
throws_ok{
	mkopt_hash [qw(foo foo)], "mkopt", 1;
} qr/multiple definitions/i, 'unique-mkopt_hash';

# validation

throws_ok{
	mkopt [foo => []], "test", 0, 'HASH';
} qr/ARRAY-ref values are not valid.* in test opt list/;
throws_ok{
	mkopt [foo => []], "test", 0, [qw(SCALAR CODE HASH GLOB)];
} qr/ARRAY-ref values are not valid.* in test opt list/;
throws_ok{
	mkopt [foo => []], "test", 0, 'Bar';
} qr/ARRAY-ref values are not valid.* in test opt list/;

throws_ok{
	mkopt [foo => Foo->new], "test", 0, 'Bar';
} qr/Foo-ref values are not valid.* in test opt list/;
throws_ok{
	mkopt [foo => Foo->new], "test", 0, ['CODE', 'Bar'];
} qr/Foo-ref values are not valid.* in test opt list/;


# bad uses

dies_ok{
	mkopt [], 'test', 0, anon_scalar();
};

dies_ok{
	mkopt anon_scalar();
};
dies_ok{
	mkopt_hash anon_scalar();
};

dies_ok{
	mkopt(BadHash->new(), 'test');
};