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 => 36;
use Test::Exception;

use Data::Util qw(:all);

BEGIN{
	package Foo;
	use overload fallback => 1;
	sub new{
		bless {} => shift;
	}


	package MyArray;
	use overload
		'@{}' => 'as_array',
		fallback => 1;

	sub new{
		bless {array => []} => shift;
	}
	sub as_array{
		shift()->{array};
	}
	package AnyRef;
	use overload
		'@{}' => 'as_array',
		'%{}' => 'as_hash',
		'${}' => 'as_scalar',
		'*{}' => 'as_glob',
		'&{}' => 'as_code',
		fallback => 1;

	my $s;
	my @a;
	my %h;
	my $gref; select select $gref;
	sub c{1}

	sub new{
		bless {} => shift;
	}
	sub as_scalar{
		\$s;
	}
	sub as_array{
		\@a;
	}
	sub as_hash{
		\%h;
	}
	sub as_glob{
		$gref;
	}
	sub as_code{
		\&c;
	}

	package DerivedAnyRef;
	our @ISA = qw(AnyRef);

}

# :check

my $foo = Foo->new();
ok !is_array_ref($foo), 'check with overloaded';
ok !is_hash_ref($foo);

my $ma = MyArray->new();
ok  is_array_ref($ma);
ok !is_hash_ref($ma);
ok !is_scalar_ref($ma);
ok !is_code_ref($ma);
ok !is_glob_ref($ma);
ok !is_regex_ref($ma);

for my $ref(AnyRef->new(), DerivedAnyRef->new()){
	ok is_array_ref($ref);
	ok is_hash_ref($ref);
	ok is_scalar_ref($ref);
	ok is_code_ref($ref);
	ok is_glob_ref($ref);

}

# :validate

$foo = Foo->new();
dies_ok{
	array_ref($foo);
} 'validate with overloaded';
dies_ok{
	hash_ref($foo);
};

$ma = MyArray->new();
lives_and{
	ok  array_ref($ma);
};
dies_ok{ hash_ref($ma) };
dies_ok{ scalar_ref($ma) };
dies_ok{ code_ref($ma) };
dies_ok{ glob_ref($ma) };
dies_ok{ regex_ref($ma) };

for my $ref(AnyRef->new(), DerivedAnyRef->new()){
	lives_and{
		ok array_ref($ref);
		ok hash_ref($ref);
		ok scalar_ref($ref);
		ok code_ref($ref);
		ok glob_ref($ref);
	};
}