The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use warnings; use strict;
use Test::More tests => 33;

BEGIN { 
$::W4 = 0;
$SIG{__WARN__} = sub { 
	my($t) = @_;
	if ($t =~ m"\Awarning: Object::Import cannot find methods of " ||
		$t =~ m"\ASubroutine .* redefined at .*\bObject/Import\.pm ") 
	{
		$::W4++;
	}
	warn $t;
};
}

is($::W4, 0, "no warn 0");

BEGIN { 
require_ok("Math::BigInt"); 
}

{
my $bi = Math::BigInt->new("90");
use_ok("Object::Import", \$bi, deref => 1, prefix => "bi_");
is(bi_bmul(2), "180");
$bi = Math::BigInt->new("100");
is(bi_as_hex(), "0x64");
}

{
package X0;
BEGIN { $::C0 = 0; }
sub new { $::C0++; bless {}, $_[0] }
sub greet { "hello" }
DESTROY { $::C0--; }
}

{
package G0;
use Test::More;

use_ok("Object::Import", \my $ex, deref => 1, list => ["greet"]);
is($::C0, 0, "G0.0 C");
eval { greet() }; like($@, qr/\ACan't call method "greet" on an undefined value/, "G0.0 &greet dies");
$ex = X0->new;
is($::C0, 1, "G0.1 C");
is(greet(), "hello", "G0.1 &greet");
$ex = undef;
is($::C0, 0, "G0.2 C");
eval { greet() }; like($@, qr/\ACan't call method "greet" on an undefined value/, "G0.2 &greet dies");
}

{
package X1;
BEGIN { $::C1 = 0; }
sub new { $::C1++; bless {}, $_[0] }
sub greet { "hello" }
DESTROY { $::C1--; }
}

{
package G1;
use Test::More;

my $ex;
BEGIN { use_ok("Object::Import", \($ex = X1->new), deref => 1, list => ["greet"]); }
is($::C1, 1, "G1.1 C");
is(greet(), "hello", "G1.1 &greet");
$ex = undef;
is($::C1, 0, "G1.2 C");
eval { greet() }; like($@, qr/\ACan't call method "greet" on an undefined value/, "G1.2 &greet dies");
}

{
package X2;
sub greet { ${$_[0]}[0] }
}

{
package G2;
use Test::More;

our $ex = X1->new;
use_ok("Object::Import", \$ex, deref => 1, prefix => "hr");
use_ok("Object::Import", "G2::ex", deref => 1, prefix => "gr");
use_ok("Object::Import", *ex, deref => 1, prefix => "sr");
for (qw"hrgreet grgreet srgreet") {
	no strict "refs";
	ok(defined(&$_), "G2 def\&$_");
	is(&$_(), "hello", "&hrgreet");
}
$ex = bless ["bye"], X2::;
for (qw"hrgreet grgreet srgreet") {
	no strict "refs";
	ok(defined(&$_), "G2 def\&$_");
	is(&$_(), "bye", "&hrgreet");
}
}

is($::W4, 0, "no warn");

__END__