+use strict;
+use warnings;
+use Test::More 0.88;
+
+my $Have_Devel_BeginLift;
+BEGIN {
+ # setup_for_cv() introduced in 0.001001
+ $Have_Devel_BeginLift = eval q{ use Devel::BeginLift 0.001001; 1 };
+}
+
{
package MethodHandlers;
return $inject;
}
+ sub code_for {
+ my($self, $name) = @_;
+
+ my $code = $self->SUPER::code_for($name);
+
+ if( defined $name and $Have_Devel_BeginLift ) {
+ Devel::BeginLift->setup_for_cv($code);
+ }
+
+ return $code;
+ }
}
my ($test_method1, $test_method2, @test_list);
MethodHandlers->install_methodhandler(
name => 'method',
into => __PACKAGE__,
- );
+ );
+ }
+
+ # Test at_BEGIN
+ SKIP: {
+ ::skip "Need Devel::BeginLift for compile time methods", 1
+ unless $Have_Devel_BeginLift;
+ ::can_ok( "DeclareTest", qw(new foo upgrade) );
}
method new {
@test_list = (method { 1 }, sub { 2 }, method () { 3 }, sub { 4 });
+ method leftie($left) : method { $self->{left} ||= $left; $self->{left} };
}
-use Test::More 'no_plan';
my $o = DeclareTest->new(attr => "value");
is($o->main, 'main', 'declaration of package named method ok');
+$o->leftie( 'attributes work' );
+is($o->leftie, 'attributes work', 'code attributes intact');
+
$o->upgrade;
isa_ok($o, 'DeclareTest2');
is_deeply([ map { $_->() } @test_list ], [ 1, 2, 3, 4], 'binding ok');
-__END__
-/home/rhesa/perl/t/methinstaller-simple....
-ok 1 - The object isa DeclareTest
-ok 2 - @_ args ok
-ok 3 - method with argument ok
-ok 4 - declaration of package named method ok
-ok 5 - The object isa DeclareTest2
-ok 6 - absolute method declaration ok
-ok 7 - anon method with @_ ok
-ok 8 - anon method with proto ok
-ok 9 - binding ok
-1..9
-ok
-All tests successful.
-Files=1, Tests=9, 0 wallclock secs ( 0.04 usr 0.00 sys + 0.05 cusr 0.00 csys = 0.09 CPU)
-Result: PASS
+done_testing;