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
135
136
|
#!/usr/bin/perl
use v5.18;
use warnings;
use Test2::V0;
use Object::Pad 0.800 ':experimental(mop inherit_field)';
class Example {
field $field :mutator :param(initial_field) = undef;
}
my $classmeta = Object::Pad::MOP::Class->for_class( "Example" );
my $fieldmeta = $classmeta->get_field( '$field' );
is( $fieldmeta->name, "\$field", '$fieldmeta->name' );
is( $fieldmeta->sigil, "\$", '$fieldmeta->sigil' );
is( $fieldmeta->class->name, "Example", '$fieldmeta->class gives class' );
ok( $fieldmeta->has_attribute( "mutator" ), '$fieldmeta has "mutator" attribute' );
is( $fieldmeta->get_attribute_value( "mutator" ), "field",
'value of $fieldmeta "mutator" attribute' );
is( $fieldmeta->get_attribute_value( "param" ), "initial_field",
'value of $fieldmeta "param" attribute' );
is( [ $classmeta->fields ], [ $fieldmeta ],
'$classmeta->fields' );
# $fieldmeta->value as accessor
{
my $obj = Example->new;
$obj->field = "the value";
is( $fieldmeta->value( $obj ), "the value",
'$fieldmeta->value as accessor' );
}
# $fieldmeta->value as mutator
{
my $obj = Example->new;
$fieldmeta->value( $obj ) = "a new value";
is( $obj->field, "a new value",
'$obj->field after $fieldmeta->value as mutator' );
}
# fieldmeta on roles (RT138927)
{
role ARole {
field $data = 42;
}
my $fieldmeta = Object::Pad::MOP::Class->for_class( 'ARole' )->get_field( '$data' );
is( $fieldmeta->name, '$data', '$fieldmeta->name for field of role' );
class AClass {
apply ARole;
field $data = 21;
}
my $obja = AClass->new;
is( $fieldmeta->value( $obja ), 42,
'$fieldmeta->value as accessor on role instance fetches correct field' );
class BClass {
inherit AClass;
field $data = 63;
}
my $objb = BClass->new;
is( $fieldmeta->value( $objb ), 42,
'$fieldmeta->value as accessor on role instance subclass fetches correct field' );
}
# Inherited fields aren't directly visible
{
class CClass {
field $x :inheritable;
}
class DClass {
inherit CClass qw( $x );
}
my $classmeta = Object::Pad::MOP::Class->for_class( 'DClass' );
like( dies { $classmeta->get_field( '$x' ) },
qr/^Class DClass does not have a field called '\$x' at /,
'Attempt to get fieldmeta for inherited field fails' );
is( [ $classmeta->fields ], [],
'->fields returns an empty list' );
}
# RT136869
{
class A {
field @arr;
ADJUST { @arr = (1,2,3) }
method m { @arr }
}
role R {
field $data :param;
}
class B { inherit A; apply R; }
is( [ B->new( data => 456 )->m ], [ 1, 2, 3 ],
'Role params are embedded correctly' );
}
# Forbid writing to non-scalar fields via ->value
{
class List {
field @values :reader;
}
my $list = List->new;
my $arrayfieldmeta = Object::Pad::MOP::Class->for_class( "List" )
->get_field( '@values' );
like( dies { no warnings; $arrayfieldmeta->value( $list ) = [] },
qr/^Modification of a read-only value attempted at /,
'Attempt to set value of list field fails' );
my $e;
ok( !defined( $e = dies { @{ $arrayfieldmeta->value( $list ) } = (1,2,3) } ),
'->value accessor still works fine' ) or
diag( "Exception was $e" );
is( [ $list->values ], [ 1,2,3 ], '$list->values after modification via fieldmeta' );
}
done_testing;
|
