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
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Moose::Util::MetaRole;
BEGIN
{
package My::Meta::Class;
use Moose;
extends 'Moose::Meta::Class';
}
BEGIN
{
package My::Meta::Attribute;
use Moose;
extends 'Moose::Meta::Attribute';
}
BEGIN
{
package My::Meta::Method;
use Moose;
extends 'Moose::Meta::Method';
}
BEGIN
{
package My::Meta::Instance;
use Moose;
extends 'Moose::Meta::Instance';
}
BEGIN
{
package Role::Foo;
use Moose::Role;
has 'foo' => ( is => 'ro', default => 10 );
}
{
package My::Class;
use metaclass 'My::Meta::Class';
use Moose;
}
{
package My::Class2;
use metaclass 'My::Meta::Class' => (
attribute_metaclass => 'My::Meta::Attribute',
method_metaclass => 'My::Meta::Method',
instance_metaclass => 'My::Meta::Instance',
);
use Moose;
}
{
Moose::Util::MetaRole::apply_metaroles(
for => 'My::Class',
class_metaroles => { class => ['Role::Foo'] },
);
ok( My::Class->meta()->meta()->does_role('Role::Foo'),
'apply Role::Foo to My::Class->meta()' );
has_superclass( My::Class->meta(), 'My::Meta::Class',
'apply_metaroles works with metaclass.pm' );
}
{
Moose::Util::MetaRole::apply_metaroles(
for => 'My::Class2',
class_metaroles => {
attribute => ['Role::Foo'],
method => ['Role::Foo'],
instance => ['Role::Foo'],
},
);
ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} );
has_superclass( My::Class2->meta()->attribute_metaclass(), 'My::Meta::Attribute',
'... and this does not interfere with attribute metaclass set via metaclass.pm' );
ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
has_superclass( My::Class2->meta()->method_metaclass(), 'My::Meta::Method',
'... and this does not interfere with method metaclass set via metaclass.pm' );
ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
q{apply Role::Foo to My::Class2->meta()'s instance metaclass} );
has_superclass( My::Class2->meta()->instance_metaclass(), 'My::Meta::Instance',
'... and this does not interfere with instance metaclass set via metaclass.pm' );
}
# like isa_ok but works with a class name, not just refs
sub has_superclass {
my $thing = shift;
my $parent = shift;
my $desc = shift;
my %supers = map { $_ => 1 } $thing->meta()->superclasses();
local $Test::Builder::Level = $Test::Builder::Level + 1;
ok( $supers{$parent}, $desc );
}
done_testing;
|
