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
|
use strict;
use warnings;
use Test::More;
use Test::Fatal;
use Test::Moose;
use lib 'lib';
require MooseX::SetOnce;
{
package Apple;
use Moose;
has color => (
is => 'rw',
traits => [ qw(SetOnce) ],
);
}
{
package Orange;
use Moose;
has color => (
reader => 'get_color',
writer => 'set_color',
traits => [ qw(SetOnce) ],
);
}
{
package Tangerine;
use Moose;
extends 'Orange';
}
with_immutable {
for my $set (
[ Apple => qw( color color) ],
[ Orange => qw(get_color set_color) ],
[ Tangerine => qw(get_color set_color) ],
) {
my ($class, $getter, $setter) = @$set;
my $object = $class->new;
{
is(
exception { $object->$setter('green'); },
undef,
"can set a SetOnce attr once",
);
is($object->$getter, 'green', "it has the first value we set");
}
{
like(
exception { $object->$setter('blue'); },
qr{cannot change value.+\bcolor\b},
"can't set a SetOnce attr twice (via $setter)",
);
is($object->$getter, 'green', "it has the first value we set");
}
{
like(
exception {
$object->meta->find_attribute_by_name('color')->set_value($object, 'yellow');
},
qr{cannot change value.+\bcolor\b},
"can't set a SetOnce attr twice (via set_value)",
);
is($object->$getter, 'green', "it has the first value we set");
}
my $object2 = $class->new(color => 'green');
{
like(
exception { $object2->$setter('blue'); },
qr{cannot change value.+\bcolor\b},
"can't set a SetOnce attr twice (via $setter)",
);
is($object2->$getter, 'green', "it has the first value we set");
}
{
like(
exception {
$object2->meta->find_attribute_by_name('color')->set_value($object, 'yellow');
},
qr{cannot change value.+\bcolor\b},
"can't set a SetOnce attr twice (via set_value)",
);
is($object2->$getter, 'green', "it has the first value we set");
}
}
} 'Apple', 'Orange';
done_testing;
|
