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
|
use strict;
use warnings;
use Test::More;
use Try::Tiny;
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) ],
);
}
for my $set (
[ Apple => qw( color color) ],
[ Orange => qw(get_color set_color) ],
) {
my ($class, $getter, $setter) = @$set;
my $object = $class->new;
{
my $error;
my $died = try {
$object->$setter('green');
return;
} catch {
$error = $_;
return 1;
};
ok( ! $died, "can set a SetOnce attr once") or diag $error;
is($object->$getter, 'green', "it has the first value we set");
}
{
my $error;
my $died = try {
$object->$setter('blue');
return;
} catch {
$error = $_;
return 1;
};
ok( $died, "can't set a SetOnce attr twice (via $setter)");
is($object->$getter, 'green', "it has the first value we set");
}
{
my $error;
my $died = try {
$object->meta->get_attribute('color')->set_value($object, 'yellow');
return;
} catch {
$error = $_;
return 1;
};
ok( $died, "can't set a SetOnce attr twice (via set_value)");
is($object->$getter, 'green', "it has the first value we set");
}
}
done_testing;
|
