#!/usr/bin/perl
BEGIN {
chdir
't'
if
-d
't'
;
require
q(./test.pl)
;
set_up_inc(
'../lib'
,
'lib'
);
}
plan(
tests
=> 12);
{
{
sub
new {
bless
{},
$_
[0] }
sub
bar {
'Foo::bar'
}
}
my
$foo
= Foo->new();
object_ok(
$foo
,
'Foo'
);
can_ok(
$foo
,
'bar'
);
is(
$foo
->bar(),
'Foo::bar'
,
'... got the right return value'
);
{
our
@ISA
= (
'Foo'
);
}
my
$bar
= Bar->new();
object_ok(
$bar
,
'Bar'
);
object_ok(
$bar
,
'Foo'
);
SKIP: {
eval
'use Sub::Name'
;
skip(
"Sub::Name is required for this test"
, 3)
if
$@;
my
$m
=
sub
{ (
shift
)->
next
::method() };
Sub::Name::subname(
'Bar::bar'
,
$m
);
{
no
strict
'refs'
;
*{
'Bar::bar'
} =
$m
;
}
can_ok(
$bar
,
'bar'
);
my
$value
=
eval
{
$bar
->bar() };
ok(!$@,
'... calling bar() succeeded'
) || diag $@;
is(
$value
,
'Foo::bar'
,
'... got the right return value too'
);
}
{
our
@ISA
= (
'Foo'
);
}
my
$baz
= Baz->new();
object_ok(
$baz
,
'Baz'
);
object_ok(
$baz
,
'Foo'
);
{
my
$m
=
sub
{ (
shift
)->
next
::method() };
{
no
strict
'refs'
;
*{
'Baz::bar'
} =
$m
;
}
eval
{
$baz
->bar() };
ok($@,
'... calling bar() with next::method failed'
) || diag $@;
}
{
sub
foo { No::Such::Class->
next
::can }
}
eval
{ Qux->foo() };
is($@,
''
,
"->next::can on non-existing package name"
);
}