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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
use strict;
use warnings;
no warnings 'once';
use Test::More;
BEGIN {
package MyRole1;
our $before_scalar = 1;
sub before_sub {}
sub before_sub_blessed {}
sub before_stub;
sub before_stub_proto ($);
use constant before_constant => 1;
use constant before_constant_list => (4, 5);
use constant before_constant_glob => 1;
our $before_constant_glob = 1;
use constant before_constant_inflate => 1;
use constant before_constant_list_inflate => (4, 5);
use constant before_constant_deflate => 1;
# subs stored directly in the stash are meant to be supported in perl 5.22+,
# but until 5.26.1 they have a risk of segfaulting. perl itself won't ever
# install subs in exactly this form, so we're safe to just dodge the issue
# in the test and not account for it in Role::Tiny itself.
BEGIN {
if ("$]" >= 5.026001) {
$MyRole1::{'blorf'} = sub { 'blorf' };
}
}
use Role::Tiny;
no warnings 'once';
our $after_scalar = 1;
sub after_sub {}
sub after_sub_blessed {}
sub after_stub;
sub after_stub_proto ($);
use constant after_constant => 1;
use constant after_constant_list => (4, 5);
use constant after_constant_glob => 1;
our $after_constant_glob = 1;
use constant after_constant_inflate => (my $f = 1);
use constant after_constant_list_inflate => (4, 5);
for (
\&before_constant_inflate,
\&before_constant_list_inflate,
\&after_constant_inflate,
\&after_constant_list_inflate,
) {}
my $deflated = before_constant_deflate;
bless \&before_sub_blessed;
bless \&after_sub_blessed;
}
{
package MyClass1;
no warnings 'once';
our $GLOBAL1 = 1;
sub method {}
}
my @methods = qw(
after_sub
after_sub_blessed
after_stub
after_stub_proto
after_constant
after_constant_list
after_constant_glob
after_constant_inflate
after_constant_list_inflate
);
my $type = ref $MyRole1::{'blorf'};
my $role_methods = Role::Tiny->_concrete_methods_of('MyRole1');
is_deeply([sort keys %$role_methods], [sort @methods],
'only subs after Role::Tiny import are methods' );
# only created on 5.26, but types will still match
is ref $MyRole1::{'blorf'}, $type,
'_concrete_methods_of does not inflate subrefs in stash';
my @role_method_list = Role::Tiny->methods_provided_by('MyRole1');
is_deeply([sort @role_method_list], [sort @methods],
'methods_provided_by gives method list' );
my $class_methods = Role::Tiny->_concrete_methods_of('MyClass1');
is_deeply([sort keys %$class_methods], ['method'],
'only subs from non-Role::Tiny packages are methods' );
eval { Role::Tiny->methods_provided_by('MyClass1') };
like $@,
qr/is not a Role::Tiny/,
'methods_provided_by refuses to work on classes';
{
package Look::Out::Here::Comes::A::Role;
use Role::Tiny;
sub its_a_method { 1 }
}
{
package And::Another::One;
sub its_a_method { 2 }
use Role::Tiny;
my @warnings;
local $SIG{__WARN__} = sub { push @warnings, @_ };
with 'Look::Out::Here::Comes::A::Role';
::is join('', @warnings), '',
'non-methods not overwritten by role composition';
}
{
package RoleLikeOldMoo;
use Role::Tiny;
sub not_a_method { 1 }
# simulate what older versions of Moo do to mark non-methods
$Role::Tiny::INFO{+__PACKAGE__}{not_methods}{$_} = $_
for \¬_a_method;
}
is_deeply [Role::Tiny->methods_provided_by('RoleLikeOldMoo')], [],
'subs marked in not_methods (like old Moo) are excluded from method list';
done_testing;
|
