1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
use strict;
use Test::More;
use Test::Exception;
use Class::MOP;
{
package BaseClass;
sub m1 { 1 }
sub m2 { 2 }
sub m3 { 3 }
sub m4 { 4 }
sub m5 { 5 }
package Derived;
use base qw(BaseClass);
sub m1;
sub m2 ();
sub m3 :method;
sub m4; m4() if 0;
sub m5; our $m5;;
}
my $meta = Class::MOP::Class->initialize('Derived');
my %methods = map { $_ => $meta->find_method_by_name($_) } 'm1' .. 'm5';
while (my ($name, $meta_method) = each %methods) {
is $meta_method->fully_qualified_name, "Derived::${name}";
throws_ok { $meta_method->execute } qr/Undefined subroutine .* called at/;
}
{
package Derived;
eval <<'EOC';
sub m1 { 'affe' }
sub m2 () { 'apan' }
sub m3 :method { 'tiger' }
sub m4 { 'birne' }
sub m5 { 'apfel' }
EOC
}
while (my ($name, $meta_method) = each %methods) {
is $meta_method->fully_qualified_name, "Derived::${name}";
lives_ok { $meta_method->execute };
}
done_testing;
|
