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__