use
if
$ENV
{AUTHOR_TESTING},
'Test::Warnings'
;
sub
is_method {
my
(
$ns
,
$sub
) =
@_
;
no
strict
'refs'
;
my
$cv
= B::svref_2object(\&{
"${ns}::${sub}"
});
return
if
!
$cv
->isa(
'B::CV'
);
my
$gv
=
$cv
->GV;
return
if
$gv
->isa(
'B::SPECIAL'
);
my
$pack
=
$gv
->STASH->NAME
or
return
;
return
(
$pack
eq
$ns
|| (
$pack
eq
'constant'
&&
$gv
->name eq
'__ANON__'
)
);
}
sub
imports
{
my
$ns
=
shift
;
no
strict
'refs'
;
my
@symbols
=
grep
!/::\z/ &&
defined
&{
"${ns}::$_"
},
keys
%{
"${ns}::"
};
return
grep
!is_method(
$ns
,
$_
),
@symbols
;
}
{
sub
foo {
print
"normal Foo::foo sub\n"
; }
sub
bar {
print
"normal Foo::bar sub\n"
; }
sub
baz {
print
"normal Foo::baz sub\n"
; }
}
ok(
!(
grep
$_
eq
'foo'
||
$_
eq
'bar'
||
$_
eq
'baz'
, imports(
'Foo'
)),
"original subs are not in Foo's list of imports"
,
)
or note(
'Foo has imports: '
.
join
(
', '
, imports(
'Foo'
)));
eval
{
Test::More::note
'redefining Foo::foo'
;
around
foo
=>
sub
{
my
$orig
=
shift
;
my
$ret
=
$orig
->(
@_
);
print
"wrapped foo sub\n"
};
around
bar
=>
sub
{
print
"wrapped bar sub\n"
};
around
baz
=>
sub
{
print
"wrapped baz sub\n"
};
};
ok(
!(
grep
$_
eq
'foo'
||
$_
eq
'bar'
||
$_
eq
'baz'
, imports(
'Foo'
)),
"modified subs are not in Foo's list of imports"
,
)
or note(
'Foo has imports: '
.
join
(
', '
, imports(
'Foo'
)));
done_testing;