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
|
use Moo::_strictures;
use Test::More;
use Test::Fatal;
{
package FrewWithIsa;
use Moo::Role;
use Sub::Quote;
has frooh => (
is => 'rw',
isa => sub { die 'not int' unless $_[0] =~ /^\d$/ },
);
has frew => (
is => 'rw',
isa => quote_sub(q{ die 'not int' unless $_[0] =~ /^\d$/ }),
);
package Bar;
use Moose;
with 'FrewWithIsa';
package OffByOne;
use Moo::Role;
has off_by_one => (is => 'rw', coerce => sub { $_[0] + 1 });
package Baz;
use Moo;
with 'OffByOne';
package Quux;
use Moose;
with 'OffByOne';
__PACKAGE__->meta->make_immutable;
}
is(exception {
Bar->new(frooh => 1, frew => 1);
}, undef, 'creation of valid Bar');
ok exception {
Bar->new(frooh => 'silly', frew => 1);
}, 'creation of invalid Bar validated by coderef';
ok exception {
Bar->new(frooh => 1, frew => 'goose');
}, 'creation of invalid Bar validated by quoted sub';
sub test_off_by_one {
my ($class, $type) = @_;
my $obo = $class->new(off_by_one => 1);
is($obo->off_by_one, 2, "Off by one (new) ($type)");
$obo->off_by_one(41);
is($obo->off_by_one, 42, "Off by one (set) ($type)");
}
test_off_by_one('Baz', 'Moo');
test_off_by_one('Quux', 'Moose');
my $coerce_constraint = Quux->meta->get_attribute('off_by_one')
->type_constraint->constraint;
like exception { $coerce_constraint->() }, qr/This is not going to work/,
'generated constraint is not a null constraint';
done_testing;
|
