Data-Util
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
t/06_subroutine.t view on Meta::CPAN
#!perl -w
use strict;
use Test::More tests =>32;
use Test::Exception;
use Data::Util qw(:all);
use constant PP_ONLY => $INC{'Data/Util/PurePerl.pm'};
sub get_subname{
return scalar get_code_info(@_);
}
sub foo{
42;
}
sub bar{
52;
}
{
package Base;
sub foo{
'Base::foo';
}
package Foo;
our @ISA = qw(Base);
use Data::Util qw(install_subroutine);
sub baz{}
package Callable;
use overload
'&{}' => 'codify',
;
sub new{
my $class = shift;
bless {@_} => $class;
}
sub codify{
my $self = shift;
$self->{code};
}
}
is_deeply get_subname(\&foo), 'main::foo', 'get_code_info()';
is_deeply [get_code_info(\&foo)], [qw(main foo)];
is_deeply get_subname(\&Foo::baz), 'Foo::baz', 'get_code_info()';
is_deeply [get_code_info(\&Foo::baz)], [qw(Foo baz)];
is_deeply get_subname(\&undefined_subr), 'main::undefined_subr';
is_deeply [get_code_info(\&undefined_subr)], [qw(main undefined_subr)];
no warnings 'redefine';
Foo->foo(); # touch the chache
Foo->install_subroutine(foo => \&foo);
is Foo::foo(), foo(), 'as function';
is(Foo->foo(), foo(), 'as method');
Foo->install_subroutine(foo => \&bar);
is Foo::foo(), bar(), 'redefined';
Foo->install_subroutine(foo => sub{ 314 });
is Foo::foo(), 314, 'install anonymous subr';
SKIP:{
skip 'in testing perl only', 1 if PP_ONLY;
is get_subname(\&Foo::foo), 'Foo::foo', '...named';
}
Foo->install_subroutine(foo => \&foo);
is Foo::foo(), foo();
SKIP:{
skip 'in testing perl only', 1 if PP_ONLY;
is get_subname(\&Foo::foo), 'main::foo';
}
{
my $count = 0;
Foo->install_subroutine(foo => sub{ ++$count });
}
is Foo::foo(), 1, 'install closure';
is Foo::foo(), 2;
SKIP:{
skip 'in testing perl only', 2 if PP_ONLY;
Foo->install_subroutine(foo => sub{});
is get_subname(\&Foo::foo), 'Foo::foo', 'name an anonymous subr';
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.761 second using v1.00-cache-2.02-grep-82fe00e-cpan-503542c4f10 )