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

# get_stash(), is_invocant(), invocant()

use strict;
use warnings FATAL => 'all';
use Test::More tests => 40;
use Test::Exception;

use Tie::Scalar;

use Scalar::Util qw(blessed);
use Data::Util qw(:all);

#diag 'Testing ', $INC{'Data/Util/PurePerl.pm'} ? 'PurePerl' : 'XS';

sub get_stash_pp{
	my($pkg) = @_;
	no strict 'refs';

	if(blessed $pkg){
		$pkg = ref $pkg;
	}

	return \%{$pkg . '::'};
}

foreach my $pkg( qw(main strict Data::Util ::main::Data::Util), bless{}, 'Foo'){
	is get_stash($pkg), get_stash_pp($pkg), sprintf 'get_stash(%s)', neat $pkg;
	ok is_invocant($pkg), 'is_invocant()';
	ok invocant($pkg)->isa('UNIVERSAL'), 'invocant()';
}

foreach my $pkg('not_exists', '', 1, undef, [], *ok){
	ok !defined(get_stash $pkg), 'get_stash for ' . neat($pkg) . '(invalid value)';
	ok !is_invocant($pkg), '!is_invocant()';
	throws_ok{
		invocant($pkg);
	} qr/Validation failed/, 'invocant() throws fatal error';
}

my $x = tie my($ts), 'Tie::StdScalar', 'main';
is get_stash($ts), get_stash_pp('main'), 'for magic variable';
ok is_invocant($ts);
ok invocant($ts);

ok is_invocant($x), 'is_invocant() for an object';
is invocant($x), $x, 'invocant() for an object';

is invocant('::Data::Util'),     'Data::Util';
is invocant('main::Data::Util'), 'Data::Util';